home *** CD-ROM | disk | FTP | other *** search
/ Aminet 52 / Aminet 52 (2002)(GTI - Schatztruhe)[!][Dec 2002].iso / Aminet / misc / emu / Apex-src.lha / APEX.XPL < prev    next >
Text File  |  2001-09-30  |  56KB  |  2,316 lines
  1. \APEX.XPL    FEB-25-89    VERSION 1.8-X18
  2. \COPYRIGHT 1980-1989, P.J.R. BOYLE.
  3.  
  4. \REVISION HISTORY:
  5. \NOV-DEC-85, V1.8, 96 FILES MAX, AND NUMEROUS OTHER MODS, LOREN BLANEY.
  6. \MAR-11-86, MODIFIED FOR THE 68000, L.B. (MARKED %%%)
  7. \SEP-DEC-86, MODIFIED FOR NEW SYSTEM PAGE LAYOUT.
  8. \MAR-13-87, CHANGED "SY" COMMAND FOR AMIGA AND FIXED MISC. LITTLE BUGS, L.B.
  9. \APR-09-87, CHANGED STRING AND BLIT CONVENTIONS.
  10. \FEB-25-89, ADDED OPENO(0) TO MAIN AND REMOVED OPENI(0) IN MAIN LOOP
  11. \
  12. \NOTES:
  13. \This version is loaded using LOADX (LOAD residing at $3000). The WS command
  14. \ is obsolete. These are the commands:
  15. \
  16. \    LOADX APEX
  17. \    CHANGE DEFAULTS (N/Y)? Y
  18. \    76800
  19. \    76800
  20. \    7C000
  21. \    76800
  22. \    NO
  23. \    CTRL-P
  24. \    SAVE SYSTEM.SYS
  25. \
  26. \The 68000 version retains the directory structure from the 6502 version.
  27. \Note that the 16-bit values appear to have their bytes swapped to the 68000.
  28. \
  29. \In this code the word "device" is often used synonymously with "unit".
  30. \The messages have been tailored for the Apple's 40-column, uppercase-only
  31. \ display.
  32. \
  33. \CONTENTS:
  34. \ NEXT CROUT CROUTX TXT NUMOUT NUMERIC HEX NUMIN ALPHANUM MOVENAME
  35. \ VERIFY DOREBEGIN ERROR FILERR
  36. \ PRDATE PRWEEKDAY PRSYSDATE PRNAME PRENTRY PRTDEV
  37. \ VALDRV CHKFILE NAME FIND SORT DIRSORT MOVIT GETDIR PUTDIR 
  38. \ WRTDIR RDDIR CHKDIR LOOKUP FINDFL
  39. \ CMDGET CMDSTART CMDWS CMDNEW CMDSYS CMDSIZE CMDDATE
  40. \ SHOWDIR CMDDIR CMDBD CMDTITLE CMDZERO CMDDF CMDDO
  41. \ CHKNAME ENTER CLEAR REMOVE COPY PACK CLOFIL
  42. \ CMDSQ CMDMAKE CMDDELETE CMDSAVE
  43. \ OPENOT OPENIN CMDOPEN CMDCLOSE
  44. \ CMDLIST CMDRENAME CMDUNLOCK CMDSUB
  45. \ FIXSAV LOOKER DOCMD RUN MAIN
  46.  
  47. code
  48. ABS=0,        RAN=1,        REM=2,        RESERVE=3,    SWAP=4,
  49. REBEGIN=6,    CHIN=7,        CHOUT=8,    CRLF=9,        INTOUT=11,
  50. TEXT=12,    OPENI=13,    OPENO=14,    CLOSE=15,
  51. SPACE=18,    RERUN=19,    FWRITE=30,    FREAD=31,    FRUN=28,
  52. FGET=33,    FASAVE=34,    FSAVE=35,    BLIT=36;    \%%%
  53.  
  54. \THE DIRECTORY:
  55. addr    FNAME,        \THE NAME AND EXTENSION FOR EACH FILE
  56.     FSTAT,        \THE STATUS FOR EACH FILE
  57.     STAB,        \SORT TABLE, ORDER IN ASCENDING "FBLK"S
  58.     NUMVAL,        \LAST ELEMENT OF "STAB" ARRAY (MAXSTB)
  59.     DIRCHG,        \"$A5" INDICATES DIRECTORY NEEDS TO BE SORTED
  60.     PRDEV,        \DEFAULT DEVICE NUMBER
  61.     DFNAME,        \THE DEFAULT FILE NAME AND EXTENTION
  62.     TITLE,        \TITLE OF THE VOLUME
  63.     UNUSED,        \UNUSED SPACE
  64.     FLAGS;        \I.E: PACK, BACKUP, CHECK, UNLOCKED, ABORT, EXTENDED DIR
  65. \16-BIT ARRAYS IN THE DIRECTORY:                %%%
  66. addr    FBLK,        \THE FIRST BLOCK OF EACH FILE
  67.     LBLK,        \THE LAST BLOCK
  68.     FEMBLK,        \EMPTY BLOCKS FILE LIST (FIRST BLOCK)
  69.     LEMBLK,        \ (LAST BLOCK) SORTED LARGEST SIZE FIRST
  70.     PMAXB,        \MAXIMUM BLOCK NUMBER (= UNIT SIZE -1)
  71.     APEXID,        \A 4-BYTE VALUE USED TO RECOGNIZE AN APEX DISK
  72.     VOLUME,        \UNIQUE VOLUME (DIRECTORY) ID NUMBER
  73.     DIRDAT,        \DIRECTORY DATE (SYSTEM DATE)
  74.     FDATE;        \DATE FOR EACH FILE
  75.  
  76. \SOME ABSOLUTE ADDRESS:
  77. addr    SYSPAG,        \SYSTEM PAGE BASE ADDRESS
  78.     CMDBUF;        \.CMD FILE BUFFER
  79.  
  80. \THE SYSTEM GLOBALS:
  81. addr    LOCNAM,        \LOCAL NAME OF FILE (FROM TYPED IN COMMAND)
  82.     MOSTR,        \ARRAY OF MONTH NAMES (STRING)
  83.     RNAM;        \SYSTEM-WIDE DEFAULT FILE NAME AND EXTENSION
  84. int    ABOFLG,        \FLAG: ABORT COMMAND FILES UPON ERRORS
  85.     ACTDEV,        \DEVICE (UNIT) NUMBER OF ACTIVE DEVICE
  86.     ARG1,        \COMMAND ARGUMENT
  87.     ARG2,        \COMMAND ARGUMENT
  88.     BACKBLK,    \BLOCK TO PUT BACKUP DIR IN
  89.     BAKFLG,        \FLAG: BACKUPS WANTED
  90.     BITS,        \ARRAY: BIT TABLE
  91.     BLKSIZ,        \SIZE OF A BLOCK IN BYTES
  92.     CHAR,        \LAST CHARACTER TYPED IN
  93.     CHKFLG,        \FLAG: CHECKS WANTED
  94.     CONHT,        \HEIGHT OF CONSOLE (LINES)
  95.     CONWID,        \WIDTH OF CONSOLE (CHARACTERS)
  96.     DIRBLK,        \BLOCK WHERE DIRECTORY STARTS
  97.     DIRDEV,        \DEVICE WE HAVE THE DIRECTORY OF IN MEMORY
  98.     DIRSIZ,        \DIRECTORY SIZE IN BLOCKS
  99.     DRVSET,        \FLAG: DRIVE (UNIT) SPECIFIED
  100.     FIRBLK,        \FIRST BLOCK OF FILE
  101.     FLNO,        \NUMBER OF FILE
  102.     GOTFILE,    \FLAG: 'PROC' NAME GOT A FILE NAME (NOT JUST A SPACE)
  103.     INDATE,        \DATE OF LAST INFILE
  104.     INSIZE,        \SIZE OF LAST OPENED INFILE (BLOCKS)
  105.     LASBLK,        \LAST BLOCK OF FILE
  106.     LINECTR,    \LINE COUNTER (TO PAUSE ON SCREEN BOUNDARIES)
  107.     LOCDEV,        \DEVICE (UNIT) USER ASKED FOR IN TYPED IN COMMAND
  108.     MAXBLK,        \MAXIMUM BLOCK NUMBER ALLOWED ON UNIT
  109.     MAXFL,        \HIGHEST FILE NO.
  110.     MAXSTB,        \LAST ELEMENT OF "STAB" ARRAY (NUMVAL)
  111.     PAKFLG,        \FLAG: PACKING WANTED
  112.     RDEV,        \DEFAULT UNIT NUMBER
  113.     SPECIAL,    \BIT ARRAY: BACK UP, SIZE LIMIT, KEEP DATE
  114.     SWAPFLG,    \FLAG: SWAPPING AREA IS VALID
  115.     SWITCH,        \COMMAND SWITCH--I.E. CHAR FOLLOWING "/"
  116.     SYSDAT,        \SYSTEM DATE
  117.     SYSDEV,        \THE CURRENT SYSTEM DEVICE
  118.     USERBLK;    \FIRST USER BLOCK (AFTER DIR AND RESCOD.SYS)
  119.  
  120. \32-BIT INTEGERS IN SYSTEM PAGE
  121. int    INLBLK,        \LOW BLOCK NUMBER
  122.     INHBLK,        \HIGH BLOCK NUMBER
  123.     OTLBLK,        \FIRST BLOCK OF OUTPUT FILE (LOW BYTE)
  124.     OTHBLK,        \LAST BLOCK OF OUTPUT FILE
  125.     SYSBLK,        \BLOCK SYSTEM FILE IS IN
  126.     SWPBLK,        \BLOCK SWAP FILE IS IN
  127.     USRMEM,        \USER BASE ADDRESS
  128.     PROSIZ,        \USER PROGRAM SIZE IN PAGES (NOT INCL SYSPAG)
  129.     MAXTBL,        \BLOCK HANDLER LIMIT TABLE (MAX BLOCK + 1 OF SUB-DIRS)
  130.     OFFTBL,        \BLOCK HANDLER OFFSET TABLE (BASE BLOCKS OF SUB-DIRS)
  131.     CMDPTR,        \POINTER INTO COMMAND FILE BUFFER (COMBUF)
  132.     ;
  133. int    DIRLEN;        \ARRAY: LENGTHS (IN WORDS) OF SEGMENTS OF THE DIRECTORY
  134. def    MAXSEG=10;    \THE LAST SEGMENT (ELEMENT) IN "DIRLEN"
  135. def    EXTPAT=$A5;    \FLAG PATTERN INDICATING EXTENDED DIR IS USED
  136.  
  137. \FOR MAIN:
  138. int    HASH,        \COMMAND CODE
  139.     II,        \SCRATCH
  140.     COLD,        \FLAG: COLD START
  141.     FILENO;        \RUN FILE NUMBER
  142.  
  143. \ASCII CONSTANTS:
  144. def    BEL=$07, TAB=$09, LF=$0A, FF=$0C, CR=$0D, EOF=$1A, SP=$20;
  145.  
  146. \FILE STATUS IN THE DIRECTORY (FSTAT):
  147. def    NULL=0, TENTATIVE=255, REPLACE=254, VALID=1;
  148.  
  149. \FILE STATUS IN SYSTEM PAGE (INFLG, OTFLG):
  150. def    NOFILE=0, SETUP=1, CLOSED=255;
  151.  
  152. \SYSTEM REENTRY CONDITIONS (SYSENF):
  153. def    SWAPIN=254, SAVEIN=255, BOOTIN=253, RELOAD=252;
  154.  
  155. \FAILED FLAG
  156. def    NONE=$FFFF;
  157.  
  158. \DEFINE SOME OFFSETS INTO THE SYSTEM PAGE:    %%%
  159. \(SEE MAIN FOR ADDITIONAL DEFINITIONS)
  160. def    DEXTO=$5B,    \DEFAULT EXT FOR OUTPUT FILE
  161.     DEXTI=$61,    \DEFAULT EXT FOR INPUT FILE
  162.     DEFAUL=$67,    \SPECIAL DEFAULT FLAG BYTE
  163.  
  164.     SYSENF=$100,    \FLAG SHOWING REENTRY CONDITION
  165.     SYSUNT=$101,    \UNIT SYSTEM IS ON
  166.     DATOFF=$10A,    \SYSTEM DATE (SYSDAT)
  167.     DATOF1=$10B,
  168.     DATOF2=$10C,
  169.     LOKMSK=$113,    \BIT ARRAY OF WRITE-LOCKED UNITS
  170.     \++UNTUPD=$114,\    \BIT ARRAY SHOWING UNITS NEEDING ATTENTION
  171.     DEFUNT=$115,    \USER'S DEFAULT UNIT
  172.  
  173. \OUTPUT FILE INFORMATION:
  174.     OTFLG=$15E,    \OUTPUT FILE STATUS FLAGS (1=SETUP)
  175.     OTNO=$15F,    \OUTPUT FILE NUMBER IN DIRECTORY
  176.     OTUNT=$160,    \UNIT NUMBER OUTPUT FILE IS ON
  177.  
  178. \INPUT FILE INFORMATION:
  179.     INFLG=$16A,    \INPUT FILE STATUS FLAG
  180.     INNO=$16B,    \INPUT FILE NUMBER IN DIRECTORY
  181.     INUNT=$16C,    \DEVICE NUMBER INPUT FILE IS ON
  182.  
  183.     CMDMODE=$28A,    \FLAG: COMMAND MODE (.CMD FILE)
  184.     ;
  185.  
  186. \----------------------------------------------------------------------\
  187.  
  188. proc    PUT16(ARRAY, INDEX, VALUE);
  189. \STORE A 16-BIT VALUE INTO THE DIRECTORY ARRAY ENTRY AT "INDEX"
  190. \NOTE THE BYTE ORDER IS LOW BYTE, HIGH BYTE
  191. addr    ARRAY;
  192. int    INDEX, VALUE;
  193. begin
  194. INDEX:= INDEX + INDEX;            \DOUBLE FOR WORD ENTRIES
  195. ARRAY(INDEX):= VALUE;            \STORE LOW BYTE
  196. ARRAY(INDEX+1):= SWAP(VALUE);        \STORE HIGH BYTE
  197. end;    \PUT16
  198.  
  199.  
  200.  
  201. func    GET16(ARRAY, INDEX);
  202. \RETURN A 16-BIT VALUE FROM THE DIRECTORY ARRAY ENTRY AT "INDEX"
  203. \NOTE THE BYTE ORDER IS LOW BYTE, HIGH BYTE
  204. addr    ARRAY;
  205. int    INDEX;
  206. begin
  207. INDEX:= INDEX + INDEX;            \DOUBLE FOR WORD ENTRIES
  208. return ARRAY(INDEX) + SWAP(ARRAY(INDEX+1));
  209. end;    \GET16
  210.  
  211.  
  212.  
  213. proc    NEXT;        \GET NEXT CHARACTER, SET SWITCH IF ANY
  214.  
  215.  
  216.     func    GETCH;
  217.     \RETURN "CHAR" FROM KEYBOARD, CONVERT TO UPPERCASE
  218.     begin
  219.     CHAR:= CHIN(0);
  220.     if CHAR>=^a & CHAR<=^z then CHAR:= CHAR-32;
  221.     end;    \GETCH
  222.  
  223.  
  224. begin
  225. GETCH;
  226. if CHAR=^/ then
  227.     begin
  228.     GETCH;
  229.     SWITCH:= CHAR;
  230.     GETCH;
  231.     end;
  232. end;    \NEXT
  233.  
  234.  
  235.  
  236. proc    CROUT;        \DO A CRLF
  237. CRLF(0);
  238.  
  239.  
  240.  
  241. proc    CROUTX;        \CROUT, BUT PAUSE ON SCREEN BOUNDARIES
  242. int    I;
  243. begin
  244. if LINECTR>=CONHT then [I:= CHIN(1); LINECTR:= 0];
  245. CROUT;
  246. LINECTR:= LINECTR + 1;
  247. end;    \CROUTX
  248.  
  249.  
  250.  
  251. proc    TXT(STR);    \OUTPUT A STRING
  252. addr    STR;
  253. TEXT(0,STR);
  254.  
  255.  
  256.  
  257. proc    NUMOUT(I);    \OUTPUT AN INTEGER
  258. int    I;
  259. INTOUT(0,I);
  260.  
  261.  
  262.  
  263. func    NUMERIC;    \RETURNS 'TRUE' IF LAST CHARACTER READ WAS A DIGIT
  264. return CHAR>=^0 & CHAR<=^9;
  265.  
  266.  
  267.  
  268. func    HEX;        \RETURNS 'TRUE' IF LAST CHARACTER WAS A HEX DIGIT
  269. return NUMERIC ! (CHAR>=^A & CHAR<=^F);
  270.  
  271.  
  272.  
  273. func    NUMIN;        \GET AN UNSIGNED DECIMAL OR HEX INTEGER
  274. int    I,ADD;
  275. begin
  276. while (not NUMERIC) & (CHAR#^$) do NEXT;
  277. I:= 0;
  278. if CHAR=^$ then
  279.     begin                        \HEX
  280.     NEXT;
  281.     while HEX do
  282.         begin
  283.         if CHAR<^A then ADD:= CHAR -^0
  284.         else ADD:= CHAR -^A +10;
  285.         I:= I*16 +ADD;
  286.         NEXT;
  287.         end;
  288.     end
  289. else    while NUMERIC do [I:= I *10 +CHAR -^0; NEXT];    \DECIMAL
  290. return I;
  291. end;    \NUMIN
  292.  
  293.  
  294.  
  295. func    ALPHANUM;    \RETURNS 'TRUE' IF LAST CHAR WAS ALPHANUMERIC OR "?"
  296. return NUMERIC ! (CHAR>=^A & CHAR<=^Z) ! CHAR=^?;
  297.  
  298.  
  299.  
  300. proc    MOVENAME(A,B);    \MOVE A FILE NAME FROM A TO B
  301. addr    A, B;
  302. int    I;
  303. for I:= 0,10 do B(I):= A(I);
  304.  
  305. \----------------------------------------------------------------------\
  306.  
  307. func    VERIFY;
  308. begin
  309. TXT(" - ARE YOU SURE (N/Y)? ");
  310. OPENI(0);
  311. NEXT;
  312. return CHAR = ^Y;
  313. end;    \VERIFY
  314.  
  315.  
  316.  
  317. proc    DOREBEGIN;    \RESTART APEX ON ERRORS
  318. begin
  319. if ABOFLG then                \ABORT COMMAND FILE (IF ANY)
  320.     SYSPAG(CMDMODE):= false;
  321. SYSPAG(SYSENF):= BOOTIN;
  322. REBEGIN;
  323. end;    \DOREBEGIN
  324.  
  325.  
  326.  
  327. proc    ERROR(LINE);    \ERROR HANDLER
  328. addr    LINE;
  329. begin
  330. CHOUT(0,BEL);
  331. TXT(if RAN(10)<3 then "OOPS - " else "NOPE - ");
  332. TXT(LINE);
  333. DOREBEGIN;
  334. end;    \ERROR
  335.  
  336.  
  337.  
  338. proc    FILERR;        \FILE-NOT-FOUND ERROR HANDLER
  339. int    I;
  340. addr    LINE;
  341. begin
  342. CHOUT(0,BEL);
  343. TXT("I CAN'T FIND ");
  344. NUMOUT(LOCDEV); CHOUT(0,^:);
  345. for I:= 0,7 do
  346.     if LOCNAM(I)#SP
  347.     then CHOUT(0,LOCNAM(I));
  348. if LOCNAM(8)#SP then
  349.     begin
  350.     CHOUT(0,^.);
  351.     for I:= 8,10 do
  352.         CHOUT(0,LOCNAM(I));
  353.     end;
  354. DOREBEGIN;
  355. end;    \FILERR
  356.  
  357.  
  358.  
  359. proc    FORMERR;
  360. ERROR("NO FILES OF THAT FORM");
  361.  
  362. \----------------------------------------------------------------------\
  363.  
  364. proc    PRDATE(DATE);    \OUTPUT THE DATE, E.G: NOV-07-85
  365. int    DATE;
  366. int    DAY,MO,I;
  367.  
  368.  
  369.     proc    NUM2(N);
  370.     int    N;
  371.     begin
  372.     if N<10 then CHOUT(0,^0);
  373.     NUMOUT(N);
  374.     end;    \NUM2
  375.  
  376.  
  377. begin
  378. if DATE<=0 then [TXT("NO DATE  "); return];
  379. DATE:= DATE/32;
  380. DAY:= REM(0);
  381. DATE:= DATE/16;
  382. MO:= REM(0);
  383.  
  384. MO:= (MO-1)*3;
  385. for I:= 0,2 do CHOUT(0,MOSTR(MO+I));
  386. CHOUT(0,^-);
  387. NUM2(DAY);
  388. CHOUT(0,^-);
  389. NUM2(DATE+76);
  390. end;    \PRDATE
  391.  
  392.  
  393.  
  394. proc    PRWEEKDAY(DATE);    \PRINT THE DAY OF THE WEEK
  395. int    DATE;
  396. int    DAY,MO,YR,X,I;
  397. addr    DAYWRD;
  398. begin
  399. DAYWRD:= "MONTUEWEDTHUFRISATSUN";
  400. if DATE<=0 then return;
  401.  
  402. YR:= DATE/32;
  403. DAY:= REM(0);
  404. YR:= YR/16;
  405. MO:= REM(0);
  406. if MO<=2 then [MO:= MO+10; YR:= YR-1] else MO:= MO-2;
  407. X:= 3 *( REM(((26*MO - 2)/10 + DAY + YR + YR/4 + 60) /7) );
  408. for I:= 0,2 do CHOUT(0,DAYWRD(X+I));
  409. end;    \PRWEEKDAY
  410.  
  411.  
  412.  
  413. proc    PRSYSDATE;    \PRINT THE SYSTEM DATE, E.G: THU, NOV-07-85
  414. begin
  415. PRWEEKDAY(SYSDAT);
  416. TXT(", ");
  417. PRDATE(SYSDAT);
  418. end;    \PRSYSDATE
  419.  
  420.  
  421.  
  422. proc    PRNAME(FILE);    \OUTPUT A FILE NAME
  423. addr    FILE;
  424. int    K;
  425. begin
  426. for K:= 0,7 do CHOUT(0,FILE(K));
  427. CHOUT(0,^.);
  428. for K:= 8,10 do CHOUT(0,FILE(K));
  429. end;    \PRNAME
  430.  
  431.  
  432.  
  433. proc    PRENTRY(FILE,FLAG);    \PRINT FILE ENTRY, E.G:
  434. int    FILE,FLAG;        \FLAG:    FILENAME.EXT  123   NOV-08-85  200-222
  435. int    MIN, MAX, SIZE;        \ELSE:    FILENAME.EXT  123
  436. begin
  437. PRNAME(FNAME +FILE*11);
  438. MIN:= GET16(FBLK,FILE);
  439. MAX:= GET16(LBLK,FILE);
  440. SIZE:= MAX-MIN+1;
  441. TXT("  "); NUMOUT(SIZE);
  442. if not FLAG then return;
  443.  
  444. while SIZE<10000 do
  445.     begin
  446.     CHOUT(0,SP);
  447.     if SIZE>1000 then SIZE:= 10000        \(LIMIT PROBLEM)
  448.     else SIZE:= SIZE*10;
  449.     end;
  450. CHOUT(0,SP);
  451. if GET16(FDATE,FILE) = SYSDAT then TXT("TODAY    ")
  452. else PRDATE(GET16(FDATE,FILE));
  453. TXT("  ");
  454. NUMOUT(MIN); CHOUT(0,^-); NUMOUT(MAX);
  455. end;    \PRENTRY
  456.  
  457.  
  458.  
  459. proc    PRTDEV(FILE);    \PRINT UNIT AND FILE ENTRY
  460. int    FILE;
  461. begin
  462. NUMOUT(DIRDEV);
  463. CHOUT(0,^:);
  464. PRENTRY(FILE,CONWID>60);    \SHOW LONG FORM IF CONSOLE IS WIDE ENOUGH
  465. end;    \PRTDEV
  466.  
  467. \----------------------------------------------------------------------\
  468.  
  469. proc    VALDRV(DRV);    \CHECK FOR VALID UNIT NUMBER
  470. int    DRV;
  471. int    I;
  472. begin
  473. if DRV<0 ! DRV>7 then ERROR("BAD UNIT NUMBER");
  474. end;    \VALDRV
  475.  
  476.  
  477.  
  478. proc    CHKFILE;
  479. begin
  480. if CHAR#SP then ERROR("NEED FILE NAME");
  481. end;    \CHKFILE
  482.  
  483.  
  484.  
  485. proc    NAME(DEFAULT,DDEV);
  486. \GET A FILE NAME FROM THE OPERATOR AND PUT IT INTO "LOCNAM".
  487. \ SET TO DEFAULT EXTENSION IF NONE WAS GIVEN. SET TO SYSTEM DEFAULT NAME (RNAM)
  488. \ IF NONE WAS GIVEN. EXPAND *'S INTO FIELDS OF ?'S.
  489. \OUTPUTS:    LOCNAM        FILE NAME AND EXTENSION
  490. \        LOCDEV        DEVICE (UNIT) NUMBER
  491. \        GOTFILE        FLAG: A FILE WAS INPUT (NOT JUST A SPACE)
  492. \        DRVSET        FLAG: A DEVICE NUMBER WAS EXPLICITLY SPECIFIED
  493. \        ARG1, ARG2    GENERAL PURPOSE NUMERIC ARGUMENTS
  494. \INPUTS:    RNAM        SYSTEM-WIDE DEFAULT FILE NAME AND EXTENSION
  495. \NOTE: THE LOADER (LOAD.XPL) DEPENDS ON THIS ROUTINE HAVING A ONE-CHARACTER
  496. \ LOOK AHEAD.
  497. \
  498. addr    DEFAULT;        \DEFAULT EXTENSION
  499. int    DDEV;            \DEFAULT DEVICE NUMBER
  500. int    K;
  501. begin
  502. GOTFILE:= false;
  503. while CHAR=SP do NEXT;
  504. if NUMERIC then
  505.     [LOCDEV:= NUMIN; DRVSET:= true]
  506. else    [LOCDEV:= DDEV; DRVSET:= false];
  507. VALDRV(LOCDEV);
  508. if CHAR=^: then [NEXT; GOTFILE:= true];
  509. K:= 0;
  510. while ALPHANUM do
  511.     begin
  512.     LOCNAM(K):= CHAR;
  513.     if K<8 then K:= K+1;
  514.     NEXT;
  515.     GOTFILE:= true;
  516.     end;
  517. if CHAR=^* then        \FILL OUT THE REST OF THE NAME WITH "?"
  518.     [GOTFILE:= true;
  519.     for K:= K,7 do LOCNAM(K):= ^?;
  520.     NEXT]
  521. else    for K:= K,7 do LOCNAM(K):= SP;
  522.  
  523. if CHAR=^. then
  524.     begin
  525.     GOTFILE:= true;
  526.     NEXT;
  527.     K:= 8;
  528.     while ALPHANUM do
  529.         begin
  530.         LOCNAM(K):= CHAR;
  531.         if K<11 then K:= K+1;
  532.         NEXT;
  533.         end;
  534.     if CHAR=^* then
  535.         [for K:= K,10 do LOCNAM(K):= ^?;
  536.         NEXT]
  537.     else for K:= K,10 do LOCNAM(K):= SP;
  538.     end
  539. else    begin
  540.     LOCNAM(8):= DEFAULT(0);
  541.     LOCNAM(9):= DEFAULT(1);
  542.     LOCNAM(10):= DEFAULT(2);
  543.     end;
  544.  
  545. if LOCNAM(0)=SP then
  546.     for K:= 0,7 do LOCNAM(K):= RNAM(K);
  547.  
  548. if CHAR=^= then
  549.     begin
  550.     ARG1:= NUMIN;
  551.     if CHAR=^, then ARG2:= NUMIN
  552.     else ARG2:= NONE;
  553.     end
  554. else [ARG1:= NONE; ARG2:= NONE];
  555. end;    \NAME
  556.  
  557.  
  558.  
  559. func    FIND(BSIZ);
  560. \FIND THE SMALLEST EMPTY WHICH IS "BSIZ" OR MORE.
  561. \IF THERE IS NONE, THEN FIND THE LARGEST AVAILABLE.
  562. \SET "FIRBLK" AND "LASBLK" TO IT. RETURN ITS SIZE.
  563. \INPUTS:    FEMBLK        EMPTY BLOCKS ARRAY (FIRST BLOCK) 
  564. \        LEMBLK        (LAST BLOCK)
  565. int    BSIZ;        \THE BLOCK SIZE WE'RE LOOKING FOR
  566. int    LMAX,        \SIZE OF MAX EMPTY
  567.     FMAX,        \FILE NUMBER OF MAX EMPTY
  568.     I,SIZE;
  569. begin
  570. I:= 5;
  571. LMAX:= 0; FMAX:= 0;
  572. loop    begin        \SCAN LIST OF EMPTY BLOCKS FROM SMALLEST TO BIGGEST
  573.     SIZE:= if GET16(FEMBLK,I)=0 then 0
  574.         else GET16(LEMBLK,I) - GET16(FEMBLK,I) + 1;
  575.     if SIZE>LMAX then [LMAX:= SIZE; FMAX:= I];
  576.     if SIZE>=BSIZ then quit;
  577.     if I=0 then quit;
  578.     I:= I-1;
  579.     end;
  580. if LMAX=0 then
  581.     begin
  582.     FIRBLK:= 0;
  583.     LASBLK:= 0;
  584.     return 0;
  585.     end;
  586. if SIZE<BSIZ then I:= FMAX;
  587. LASBLK:= GET16(LEMBLK,I);
  588. FIRBLK:= GET16(FEMBLK,I);
  589. return LASBLK-FIRBLK+1;
  590. end;    \FIND
  591.  
  592. \----------------------------------------------------------------------\
  593.  
  594. proc    SORT(VAL,PTR,MAX);
  595. \QUICKSORT POINTER ARRAY, "PTR", (0-"MAX"). "VAL" IS THE CORRESPONDENT
  596. \ 16-BIT ARRAY OF INTEGER VALUES.
  597. addr    VAL;        \%%%
  598. addr    PTR;
  599. int    MAX;
  600. int    N,KEY,L,R,T;
  601. begin
  602. N:= ((MAX+2)/2)-1;
  603. KEY:= GET16(VAL,PTR(N));
  604. L:= 0; R:= MAX;
  605. loop    begin
  606.     while GET16(VAL,PTR(L)) < KEY do L:= L+1;
  607.     while (GET16(VAL,PTR(R)) >= KEY) & (R>0) do R:= R-1;
  608.     if L>=R then quit;
  609.     T:= PTR(L);
  610.     PTR(L):= PTR(R);
  611.     PTR(R):= T;
  612.     end;
  613. if GET16(VAL,PTR(R))>KEY then
  614.     begin
  615.     T:= PTR(R);
  616.     PTR(R):= PTR(N);
  617.     PTR(N):= T;
  618.     end;
  619. if R>0 then SORT(VAL,PTR,R);
  620. if MAX-R-1>0 then SORT(VAL,PTR+R+1,MAX-R-1);
  621. end;    \SORT
  622.  
  623.  
  624.  
  625. proc    DIRSORT;    \SORT DIRECTORY BY "FBLK" AND EMPTY SIZE
  626. \INPUTS: MAXFL        MAXIMUM POSSIBLE FILE NUMBER
  627. \    STAB        SORT TABLE (IN DIRECTORY)
  628. \    FBLK        FIRST BLOCK (IN DIRECTORY)
  629. int    I,J,K,
  630.     FEMB,LEMB,    \FIRST & LAST EMPTY BLOCKS
  631.     MAXEM,        \MAX
  632.     ESIZ;        \EMPTY SIZE
  633. addr    FSTB,
  634.     FRESIZ;        \ARRAY: FREE SIZE    %%%
  635. begin
  636. \SORT THE FILES INTO ASCENDING "FIRST BLOCK NUMBERS" (FBLK)
  637. J:= 0;
  638. for I:= 0,MAXFL do
  639.     if FSTAT(I)=VALID then
  640.         [STAB(J):= I; J:= J+1];
  641. MAXSTB:= J-1;
  642. NUMVAL(0):= MAXSTB;
  643. SORT(FBLK,STAB,MAXSTB);
  644.  
  645. \PRODUCE THE EMPTIES LIST
  646. MAXEM:= MAXSTB+1;
  647. FSTB:= RESERVE(MAXEM+1);
  648. FRESIZ:= RESERVE(2*(MAXEM+1));
  649. J:= 0;
  650. for I:= 0,MAXEM do
  651.     begin
  652.     FEMB:= if I=0 then USERBLK
  653.         else GET16(LBLK,STAB(I-1)) +1;
  654.     LEMB:= if I=MAXEM then MAXBLK
  655.         else GET16(FBLK,STAB(I)) -1;
  656.     ESIZ:= LEMB-FEMB+1;
  657.     if ESIZ>0 then
  658.         begin
  659.         FSTB(J):= I;
  660.         PUT16(FRESIZ,I,ESIZ);
  661.         J:= J+1;
  662.         end;
  663.     end;
  664. MAXEM:= J-1;
  665.  
  666. \SORT THE EMPTIES LIST BY SIZE
  667. if MAXEM>=0 then
  668.     SORT(FRESIZ,FSTB,MAXEM);
  669.  
  670. \COPY THE EMPTIES LIST INTO THE DIRECTORY, BIGGEST FIRST
  671. I:= MAXEM;
  672. K:= 0;
  673. while (K<6) & (I>=0) do
  674.     begin
  675.     J:= FSTB(I);
  676.     PUT16(FEMBLK, K, if J=0 then USERBLK
  677.         else GET16(LBLK,STAB(J-1)) +1);
  678.     PUT16(LEMBLK, K, if J>MAXSTB then MAXBLK
  679.         else GET16(FBLK,STAB(J)) -1);
  680.     K:= K+1;
  681.     I:= I-1;
  682.     end;
  683. for I:= K,5 do [PUT16(FEMBLK,I,0); PUT16(LEMBLK,I,0)];
  684. \FOR TESTS WE PRINT IT
  685. \TEXT(0,"DIAG, EMPTIES LIST:"); CROUT;
  686. \for I:= 0,5 do
  687. \    begin
  688. \    INTOUT(0,GET16(FEMBLK,I)); CHOUT(0,^,); INTOUT(0,GET16(LEMBLK,I));
  689. \    CROUT;
  690. \    end;
  691. DIRCHG(0):= 0;            \DIRECTORY IS NOW SORTED
  692. end;    \DIRSORT
  693.  
  694. \----------------------------------------------------------------------\
  695. \
  696. \DISK MAP:
  697. \   0  1  2  3  4   5  6  7  8   9  10 11 12  13 14 15 16  17
  698. \ BOOT +-- XD --+   +-- XB --+   +-- DI --+   +-- BD --+   +-- RESCOD -->
  699. \      +------ EXTENDED -----+   +------ PRIMARY ------+
  700.  
  701. proc    MOVIT(AB1,AB2,LEN);    \MOVE "LEN" WORDS INTO B1 FROM B2
  702. int    AB1,AB2,LEN,LEN2;    \B1 & B2 ARE LEFT POINTING TO THE LAST POSITION
  703. int    B1, B2, I;
  704. begin
  705. B1:= AB1(0);
  706. B2:= AB2(0);
  707. LEN2:= LEN+LEN;
  708. BLIT(B2, B1, LEN2);
  709. AB1(0):= B1 + LEN2;
  710. AB2(0):= B2 + LEN2;
  711. end;    \MOVIT
  712.  
  713.  
  714.  
  715. proc    GETDIR(DEV, BAKDIR);    \READ IN THE DIRECTORY
  716. int    DEV, BAKDIR;
  717.  
  718. int    I, EXTDIR, BASE1, BASE2, BASE3;
  719. begin
  720. EXTDIR:= RESERVE(1024);
  721.  
  722. \READ THE EXTENDED DIR INTO "EXTDIR"
  723. FREAD(DEV, if BAKDIR then 5 else 1, EXTDIR, DIRSIZ);
  724.  
  725. \READ PRIMARY DIRECTORY INTO THE BIG DIRECTORY SPACE
  726. FREAD(DEV, if BAKDIR then 13 else 9, FNAME, DIRSIZ);
  727.  
  728. \MERGE THE EXTENDED DIRECTORY INTO THE PRIMARY DIRECTORY
  729. BASE1:= FNAME+528;    \(FSTAT)
  730. BASE2:= EXTDIR+528;
  731. BASE3:= FSTAT;
  732. for I:= 0,MAXSEG do
  733.     begin
  734.     MOVIT(addr BASE3, addr BASE1, DIRLEN(I));
  735.     MOVIT(addr BASE3, addr BASE2, DIRLEN(I));
  736.     end;
  737. BLIT(EXTDIR, FNAME+528, 528);
  738.  
  739. MAXFL:= if FLAGS(7)=EXTPAT then 95 else 47;
  740. end;    \GETDIR
  741.  
  742.  
  743.  
  744.  
  745. proc    PUTDIR(DEV, BAKDIR);    \WRITE THE DIRECTORY
  746. int    DEV, BAKDIR;
  747. int    I, EXTDIR, BASE1, BASE2, BASE3;
  748. begin
  749. EXTDIR:= RESERVE(1024);
  750.  
  751. \SEPARATE THE BIG DIR INTO THE PRIMARY DIR AND THE EXTENDED DIR
  752. BLIT(FNAME+528, EXTDIR, 528);
  753. BASE1:= FNAME+528;
  754. BASE2:= EXTDIR+528;
  755. BASE3:= FSTAT;
  756. for I:= 0,MAXSEG do
  757.     begin
  758.     MOVIT(addr BASE1, addr BASE3, DIRLEN(I));
  759.     MOVIT(addr BASE2, addr BASE3, DIRLEN(I));
  760.     end;
  761.  
  762. \IF EXTENDED DIR IS USED THEN WRITE "EXTDIR" INTO THE EXTENDED DIR
  763. if FLAGS(7)=EXTPAT then
  764.     FWRITE(DEV, if BAKDIR then 5 else 1, EXTDIR, DIRSIZ);
  765.  
  766. \WRITE THE PRIMARY DIR
  767. FWRITE(DEV, if BAKDIR then 13 else 9, FNAME, DIRSIZ);
  768.  
  769. \NOW FIX THE BIG DIR
  770. BLIT(EXTDIR, FNAME+528, 528);
  771. end;    \PUTDIR
  772.  
  773. \----------------------------------------------------------------------\
  774.  
  775. proc    LOCKERR;
  776. begin
  777. if FLAGS(3) then else ERROR("UNIT IS WRITE LOCKED");
  778. end;    \LOCKERR
  779.  
  780.  
  781.  
  782. proc    WRTDIR;        \WRITE THE DIRECTORY; MAKE SURE IT'S SORTED
  783. addr    BLOCK;
  784. def    VOLOFF=74;    \OFFSET INTO 3RD BLOCK FOR VOLUME NUMBER (IN WORDS)
  785. begin
  786. BLOCK:= RESERVE(BLKSIZ);
  787. FREAD(DIRDEV,DIRBLK+3,BLOCK,1);
  788. if GET16(BLOCK,VOLOFF) # GET16(VOLUME,0) then
  789.     ERROR("YOU CHANGED DISKS!");    \YOU IDIOT!
  790. LOCKERR;
  791.  
  792. DIRSORT;
  793. \++SYSPAG(UNTUPD):= SYSPAG(UNTUPD) & (not BITS(DIRDEV));
  794. APEXID(0):= ^a;
  795. APEXID(1):= ^p;
  796. APEXID(2):= ^e;
  797. APEXID(3):= ^x;
  798. PUTDIR(DIRDEV,false);
  799. end;    \WRTDIR
  800.  
  801.  
  802.  
  803. proc    RDDIR(DEV);    \READ DIRECTORY FROM DEVICE "DEV"
  804. int    DEV;
  805. begin
  806. VALDRV(DEV);
  807. DIRDEV:= DEV;
  808. GETDIR(DIRDEV,false);
  809.  
  810. MAXBLK:= GET16(PMAXB,0);
  811. MAXSTB:= NUMVAL(0);
  812. if MAXSTB>MAXFL then MAXSTB:= -1;    \IN CASE IT'S EMPTY
  813.  
  814. \SET THE SYSTEM PAGE DEVICE SIZE TABLE
  815. MAXTBL(DEV):= OFFTBL(DEV) + MAXBLK + 1;
  816.  
  817. \SET THE WRITE LOCK BIT IF THE FLAGS SAY SO (FLAG: TRUE = WRITE ENABLE = 1 BIT)
  818. if FLAGS(3) then SYSPAG(LOKMSK):= SYSPAG(LOKMSK) ! BITS(DEV)
  819. else SYSPAG(LOKMSK):= SYSPAG(LOKMSK) & (not BITS(DEV));
  820.  
  821. if DIRCHG(0)=$A5 & APEXID(0)=^a & APEXID(1)=^p & APEXID(2)=^e & APEXID(3)=^x then
  822. \IT'S VERY LIKELY AN APEX DISK WHICH NEEDS SORTING.
  823. \If an external program changed the directory then we fix it here.
  824. \ In this version, we do not fix units unless we read the directory for
  825. \ Apex purposes. That is, we don't fix them until we use them.
  826. \ This affects programs which use FILEX, e.g. BASIC, in that if we go
  827. \ directly from something that affects the directory, say COPY.SAV,
  828. \ into BASIC without reading the directory with Apex then we will
  829. \ give FILEX an incorrect STAB array. FILEX should detect this error,
  830. \(not done yet)
  831. \+++    ! ((SYSPAG(UNTUPD) & BITS(DEV)) # 0)
  832.  
  833. \If we can, we sort and re-write, if not we just sort:
  834.     if FLAGS(3) then WRTDIR else DIRSORT;
  835. end;    \RDDIR
  836.  
  837.  
  838.  
  839. proc    CHKDIR(DEV);    \MAKE SURE THE DIRECTORY IS IN MEMORY
  840. int    DEV;
  841. begin
  842. if DIRDEV#DEV then RDDIR(DEV);
  843. end;    \CHKDIR
  844.  
  845.  
  846.  
  847. func    LOOKUP(FILE);
  848. \LOOKUP THE FILENAME IN "LOCNAM" BEGINNING AT DIRECTORY ENTRY NUMBER "FILE".
  849. \TAKE "?" AS WILD CHARACTERS.
  850. int    FILE;
  851. int    FILE11, L;
  852. begin
  853. CHKDIR(LOCDEV);
  854. loop    begin
  855.     if FSTAT(FILE)=VALID then
  856.         begin
  857.         FILE11:= FILE*11;
  858.         L:= 0;
  859.         loop    begin
  860.             if (LOCNAM(L) # ^?) & (FNAME(FILE11+L) # LOCNAM(L))
  861.                 then quit;
  862.             L:= L+1;
  863.             if L>=11 then return FILE;
  864.             end;
  865.         end;
  866.     FILE:= FILE+1;
  867.     if FILE>MAXFL then return NONE;
  868.     end;
  869. end;    \LOOKUP
  870.  
  871.  
  872.  
  873. func    FINDFL(DEV,FILNAM);    \RETURN THE FILE NUMBER OF "FILNAM"
  874. int    DEV;
  875. addr    FILNAM;
  876. int    I;
  877. begin
  878. LOCDEV:= DEV;
  879. for I:= 0,9 do LOCNAM(I):= FILNAM(I);
  880. LOCNAM(10):= FILNAM(10);
  881. return LOOKUP(0);
  882. end;    \FINDFL
  883.  
  884. \----------------------------------------------------------------------\
  885.  
  886. proc    CMDGET;                        \COMMAND: GET
  887. int    FILENO;
  888. begin
  889. CHKFILE;
  890. NAME("SAV",ACTDEV);
  891. FILENO:= LOOKUP(0);
  892. if FILENO=NONE then FILERR;
  893. TXT(" INFILE: "); PRTDEV(FILENO); CROUT;
  894. FGET(LOCDEV,GET16(FBLK,FILENO));    \(NEVER RETURNS)
  895. end;    \CMDGET
  896.  
  897.  
  898.  
  899. proc    CMDSTART(FLAG);                    \COMMANDS: START & SWAP
  900. int    FLAG;
  901. begin
  902. if not SWAPFLG then
  903.     begin
  904.     TXT("I WILL SWAP TO UNKNOWN STATE");
  905.     if not VERIFY then return;
  906.     end;
  907. if FLAG then FRUN(SYSDEV,SWPBLK(0)) else FGET(SYSDEV,SWPBLK(0));
  908. end;    \CMDSTART
  909.  
  910.  
  911.  
  912. \proc    CMDWS;                        \\COMMAND: WS
  913. \int    I,FILE;                        \\WRITE SYSTEM
  914. \begin
  915. \while CHAR=SP do NEXT;
  916. \if NUMERIC then ACTDEV:= NUMIN;
  917. \TXT("RE-WRITE SYSTEM ON UNIT "); NUMOUT(ACTDEV);
  918. \if not VERIFY then return;
  919. \LOCKERR;
  920.  
  921. \FILE:= FINDFL(ACTDEV,"SYSTEM  SYS");
  922. \if FILE=NONE then ERROR("NOT A SYSTEM UNIT");
  923. \FASAVE(LOCDEV,GET16(FBLK,FILE));
  924. \end;    \\CMDWS
  925.  
  926.  
  927.  
  928. proc    CMDNEW(DEV);                    \COMMAND: NEW
  929. int    DEV;        \NEW SYSTEM UNIT
  930. begin
  931. VALDRV(DEV);
  932. SYSDEV:= DEV;
  933. RDDIR(DEV);
  934. RDEV:= PRDEV(0);
  935. SYSPAG(DEFUNT):= RDEV;
  936. MOVENAME(DFNAME, RNAM);
  937. PAKFLG:= FLAGS(0)#0;
  938. BAKFLG:= FLAGS(1)#0;
  939. CHKFLG:= FLAGS(2)#0;
  940. ABOFLG:= FLAGS(5)#0;
  941.  
  942. if SYSPAG(DATOF2) # ( $FF & (not (SYSPAG(DATOFF)&SYSPAG(DATOF1))) ) then
  943.     begin        \WE DON'T HAVE A VALID SYSTEM DATE IN MEMORY
  944.     TXT("DATE FROM SYSTEM UNIT: ");    \GET IT FROM THE DISKETTE
  945.     SYSDAT:= GET16(DIRDAT,0);
  946.     SYSPAG(DATOFF):= SYSDAT;
  947.     SYSPAG(DATOF1):= SWAP(SYSDAT);
  948.     SYSPAG(DATOF2):= not (SYSPAG(DATOFF)&SYSPAG(DATOF1));
  949.     PRSYSDATE;
  950.     CROUT;
  951.     end
  952. end;    \CMDNEW
  953.  
  954.  
  955. \STRIDE VERSION:
  956. \proc    CMDSYS;                        \\COMMAND: SYSTEM
  957. \int    UNIT;
  958. \addr    MEM;        \\BASE ADDRESS OF RESCODE
  959. \ext    BOOT =$404;    \\ENTRY POINT TO BOOT.68K
  960. \begin
  961. \MEM:= $0400;
  962. \while CHAR=SP do NEXT;
  963. \if NUMERIC then
  964. \    begin
  965. \    UNIT:= NUMIN;
  966. \    FREAD(UNIT, 0, MEM, $80);    \\READ IN RESCOD.SYS, ETC.
  967. \    MEM($1500 +SYSUNT):= UNIT;
  968. \    BOOT;
  969. \    end
  970. \else    begin
  971. \    TXT("SYSTEM DEVICE: "); NUMOUT(SYSDEV); CROUT;
  972. \    end;
  973. \end;    \\CMDSYS
  974.  
  975.  
  976.  
  977. \AMIGA VERSION:
  978. proc    CMDSYS;                        \COMMAND: SYSTEM
  979. int    UNIT;
  980. addr    MEM;        \BASE ADDRESS OF RESCODE
  981. ext    VSTART =$400;    \ENTRY POINT TO RESTART APEX
  982. begin
  983. MEM:= $0400;
  984. while CHAR=SP do NEXT;
  985. if NUMERIC then
  986.     begin
  987.     UNIT:= NUMIN;
  988.     MEM(SYSUNT):= UNIT;
  989.     VSTART;
  990.     end
  991. else    begin
  992.     TXT("SYSTEM DEVICE: "); NUMOUT(SYSDEV); CROUT;
  993.     end;
  994. end;    \CMDSYS
  995.  
  996.  
  997.  
  998. proc    CMDSIZE;                    \COMMAND: SIZE
  999. \OUTPUTS:    MAXBLK
  1000. \        PMAXB
  1001. begin
  1002. while CHAR=SP do NEXT;
  1003. if NUMERIC then ACTDEV:= NUMIN;
  1004. if CHAR=^: then NEXT;
  1005.  
  1006. CHKDIR(ACTDEV);
  1007. if CHAR=^= then
  1008.     begin
  1009.     TXT("NOW ");
  1010.     MAXBLK:= NUMIN - 1;
  1011.     PUT16(PMAXB, 0, MAXBLK);
  1012.     WRTDIR;
  1013.     RDDIR(ACTDEV);        \to change the protections!    ????
  1014.     end;
  1015. TXT("UNIT "); NUMOUT(ACTDEV); TXT(" HAS SIZE "); NUMOUT(MAXBLK+1); CROUT;
  1016. end;    \CMDSIZE
  1017.  
  1018. \----------------------------------------------------------------------\
  1019.         
  1020. proc    CMDDATE;                    \COMMAND: DATE
  1021. int    COUNT, FILENO, NEWDATE;
  1022.  
  1023.  
  1024. func    GETDATE(DFDATE);    \GET A DATE FROM THE OPERATOR
  1025. int    DFDATE;        \DEFAULT DATE
  1026. int    I, MO, DAY, YR;
  1027. addr    STR;
  1028.  
  1029.  
  1030.     func    GETMO(STR);    \RETURN THE NUMBER OF THE MONTH
  1031.     addr    STR;    \STRING CONTAINING THE SPELLED-OUT MONTH NAME
  1032.     int    I,J,K,MO;
  1033.     begin
  1034.     J:= 0;
  1035.     for MO:= 1,12 do
  1036.         begin
  1037.         K:= 0;
  1038.         for I:= 0,2 do
  1039.             begin
  1040.             if STR(I)=MOSTR(J) then K:= K+1;
  1041.             J:= J+1;
  1042.             end;
  1043.         if K=3 then return MO;
  1044.         end;
  1045.     return 0;        \RETURN "0" IF MONTH NOT FOUND
  1046.     end;    \GETMO
  1047.  
  1048.  
  1049. begin    \GETDATE
  1050. DFDATE:= DFDATE/32;
  1051. DAY:= REM(0);
  1052. YR:= DFDATE/16 +76;
  1053. MO:= REM(0);
  1054. NEXT;
  1055. loop    begin
  1056.     while not ALPHANUM do [if CHAR=CR then quit; NEXT];
  1057.     if NUMERIC then I:= NUMIN
  1058.     else    begin
  1059.         STR:= RESERVE(3);
  1060.         for I:= 0,2 do [STR(I):= CHAR; if CHAR=CR then quit; NEXT];
  1061.         I:= GETMO(STR);
  1062.         end;
  1063.     if I<1 ! I>12 then quit;
  1064.     MO:= I;
  1065.  
  1066.     while not NUMERIC do [if CHAR=CR then quit; NEXT];
  1067.     I:= NUMIN;
  1068.     if I<1 ! I>31 then quit;
  1069.     DAY:= I;
  1070.  
  1071.     while not NUMERIC do [if CHAR=CR then quit; NEXT];
  1072.     YR:= REM(NUMIN/100);
  1073.     quit;
  1074.     end;
  1075. return ((YR - 76)*16 + MO)*32 + DAY;
  1076. end;    \GETDATE
  1077.  
  1078.  
  1079.  
  1080. begin    \CMDDATE
  1081. if CHAR=SP then
  1082.     begin            \A PARTICULAR FILE WAS SPECIFIED
  1083.     NAME(RNAM+8,ACTDEV);
  1084.     COUNT:= 0;
  1085.     FILENO:= LOOKUP(0);
  1086.     while FILENO#NONE do
  1087.         begin
  1088.         COUNT:= COUNT+1;
  1089.         PUT16(FDATE, FILENO, SYSDAT);
  1090.         TXT(" REDATE: "); PRTDEV(FILENO); CROUT;
  1091.         FILENO:= LOOKUP(FILENO+1);
  1092.         end;
  1093.     if COUNT=0 then FORMERR;
  1094.  
  1095.     if COUNT>=2 then
  1096.         [if VERIFY then WRTDIR else DIRDEV:= $FF]
  1097.     else    WRTDIR;
  1098.  
  1099.     end
  1100. else    begin
  1101.     CHKDIR(SYSDEV);
  1102.     loop    begin
  1103.         TXT("NEW DATE (MM-DD-YY)? ");
  1104.         OPENI(0);
  1105.         NEWDATE:= GETDATE(SYSDAT);
  1106.         if NEWDATE >= SYSDAT then quit;
  1107.         if VERIFY then quit;
  1108.         end;
  1109.     SYSDAT:= NEWDATE;
  1110.     PUT16(DIRDAT, 0, SYSDAT);
  1111.     SYSPAG(DATOFF):= SYSDAT;
  1112.     SYSPAG(DATOF1):= SWAP(SYSDAT);
  1113.     SYSPAG(DATOF2):= not (SYSPAG(DATOFF) & SYSPAG(DATOF1));
  1114.  
  1115.     TXT("TODAY IS "); PRSYSDATE; CROUT;
  1116.     WRTDIR;
  1117.     end;
  1118. end;    \CMDDATE
  1119.  
  1120. \----------------------------------------------------------------------\
  1121.  
  1122. proc    SHOWDIR;    \SHOW A DIRECTORY (MAIN OR BACKUP)
  1123. \INPUTS: MAXSTB
  1124. addr    ARRAY;        \ARRAY FOR SORTING ASSORTED ITEMS    %%%
  1125. int    I,
  1126.     SUM,        \SUM OF FREE BLOCKS
  1127.     FILENO,
  1128.     FLAG,        \FOUND A FILE OF SPECIFIED FORM
  1129.     COLS;        \COLUMNS OF FILE NAMES
  1130.  
  1131.  
  1132.     func    RADIX40(STR);    \RETURNS A 16-BIT VALUE FOR A 3-CHAR STRING
  1133.     addr    STR;        \LEGAL CHARS ARE: A-Z, 0-9, AND SPACE.
  1134.     int    I, C;
  1135.     
  1136.         func    CODE(CH);    \RETURN A CHARACTER CODE
  1137.         int    CH;
  1138.         begin
  1139.         if CH>=^A \& CH<=^Z\ then return CH-$40;    \(1-26)
  1140.         if CH>=^0 \& CH<=^9\ then return CH-21;    \(27-36)
  1141.         return 0;                    \(FOR SPACE)
  1142.         end;    \CODE
  1143.     
  1144.     begin
  1145.     C:= 0;
  1146.     for I:= 0,2 do
  1147.         C:= C*40 + CODE(STR(I));
  1148.     return C;
  1149.     end;    \RADIX40
  1150.  
  1151.  
  1152. begin
  1153. OPENI(1);
  1154. LINECTR:= 1;
  1155. COLS:= CONWID/20;
  1156.  
  1157. PRSYSDATE; TXT("   ");                        \%%%
  1158. TXT("VOL: "); NUMOUT(GET16(VOLUME,0));
  1159. TXT("   UNIT: "); NUMOUT(DIRDEV);
  1160. if FLAGS(3) then else TXT("   (LOCKED)"); CROUTX;
  1161. TITLE(63):= 0;            \MAKE SURE GARBAGE TITLE IS TERMINATED
  1162. TXT(TITLE); CROUTX;
  1163.  
  1164. if GOTFILE then
  1165.     begin            \A PARTICULAR FILE WAS SPECIFIED (NOT JUST
  1166.     FLAG:= true;        \ A SPACE)
  1167.     FILENO:= LOOKUP(0);
  1168.     while FILENO#NONE do
  1169.         begin
  1170.         FLAG:= false;
  1171.         PRENTRY(FILENO,true); CROUTX;
  1172.         FILENO:= LOOKUP(FILENO+1);
  1173.         end;
  1174.     if FLAG then FORMERR;
  1175.     end
  1176. else    begin
  1177.     if SWITCH#SP then
  1178.         begin
  1179.         ARRAY:= RESERVE((MAXFL+1)*2);
  1180.         case SWITCH of
  1181.           ^N:    for I:= 0,MAXFL do                \NAME
  1182.                 PUT16(ARRAY, I, RADIX40(FNAME + I*11));
  1183.           ^E:    for I:= 0,MAXFL do                \EXT
  1184.                 PUT16(ARRAY, I, RADIX40(FNAME + I*11 + 8));
  1185.           ^S:    for I:= 0,MAXFL do                \SIZE
  1186.                 PUT16(ARRAY, I, GET16(LBLK,I)-GET16(FBLK,I));
  1187.           ^D:    [ARRAY:= FDATE]                    \DATE
  1188.         other    ARRAY:= FBLK;                    \BLOCK
  1189.         SORT(ARRAY,STAB,MAXSTB);
  1190.         DIRDEV:= $FF;        \(DON'T KEEP A STRANGE STAB)
  1191.         end;
  1192.     for I:= 0,MAXSTB do
  1193.         begin        \NO FILE SPECIFIED, SHOW THEM ALL
  1194.         if SWITCH=SP then
  1195.             begin            \SHORT FORM
  1196.             PRNAME(FNAME +STAB(I)*11);
  1197.             if REM(I/COLS)=COLS-1 ! I=MAXSTB then CROUTX
  1198.             else TXT("       ");
  1199.             end
  1200.         else    begin            \LONG FORM
  1201.             PRENTRY(STAB(I),true); CROUTX;
  1202.             end;
  1203.         end;
  1204.     end;
  1205. SUM:= MAXBLK - USERBLK + 1;
  1206. for I:= 0,MAXFL do
  1207.     if FSTAT(I)=VALID then
  1208.     begin
  1209.     SUM:= SUM - (GET16(LBLK,I) - GET16(FBLK,I) + 1);
  1210.     end;
  1211. if SUM<0 then SUM:= 0;
  1212. TXT("FILES: "); NUMOUT(MAXSTB+1);
  1213. TXT("   FREE: "); NUMOUT(SUM);
  1214. TXT("   MAX: "); NUMOUT(FIND(32767));
  1215. TXT("   SIZE: "); NUMOUT(MAXBLK+1); CROUTX;            \%%%
  1216. CROUTX;
  1217. end;    \SHOWDIR
  1218.  
  1219.  
  1220.  
  1221. proc    CMDDIR;                        \COMMAND: DIRECTORY
  1222. begin
  1223. NAME(RNAM+8,ACTDEV);
  1224. CHKDIR(LOCDEV);
  1225. SHOWDIR;
  1226. end;    \CMDDIR
  1227.  
  1228.  
  1229.  
  1230. proc    CMDBD;                        \COMMAND BD
  1231. begin
  1232. NAME(RNAM+8,ACTDEV);
  1233. ACTDEV:= LOCDEV;
  1234. VALDRV(ACTDEV);
  1235. if SWITCH=^B then
  1236.     begin
  1237.     TXT("BACKING DIRECTORY ON UNIT "); NUMOUT(ACTDEV); CROUT;
  1238.     GETDIR(ACTDEV,false);
  1239.     PUTDIR(ACTDEV,true);
  1240.     end
  1241. else    begin
  1242.     GETDIR(ACTDEV,true);
  1243.     DIRDEV:= ACTDEV;
  1244.     MAXBLK:= GET16(PMAXB,0);
  1245.     if SWITCH=^W then
  1246.         begin
  1247.         TXT("ABOUT TO RE-WRITE DIRECTORY ON UNIT "); NUMOUT(ACTDEV);
  1248.         if VERIFY then PUTDIR(ACTDEV,false);
  1249.         end        \(WRITE LOCK NOT CHECKED)
  1250.     else    begin
  1251.         DIRSORT;
  1252.         SHOWDIR;
  1253.         end;
  1254.     end;
  1255. DIRDEV:= $FF;        \WE DO NOT HAVE A VALID DRIVE IN MEMORY
  1256. end;    \CMDBD
  1257.  
  1258. \----------------------------------------------------------------------\
  1259.  
  1260. proc    CMDTITLE;                    \COMMAND: TITLE
  1261. int    I;
  1262. begin
  1263. while CHAR=SP do NEXT;
  1264. if NUMERIC then ACTDEV:= NUMIN;
  1265. CHKDIR(ACTDEV);        \MAKE SURE WE HAVE A VALID DIRECTORY
  1266. while not ALPHANUM do NEXT;
  1267. while CHAR=^: ! CHAR=SP do NEXT;
  1268. I:= 0;
  1269. while CHAR#CR do
  1270.     begin
  1271.     TITLE(I):= CHAR;
  1272.     if I<31 then I:= I+1;
  1273.     NEXT;
  1274.     end;
  1275. TITLE(I):= 0;                \TERMINATE TITLE STRING
  1276. PUT16( VOLUME, 0, ABS(SYSDAT*256 + RAN(256)) );
  1277. LOCKERR;
  1278. PUTDIR(DIRDEV,false);        \(DON'T WRTDIR BECAUSE WE DIDN'T CHANGE DISKS)
  1279. end;    \CMDTITLE
  1280.  
  1281.  
  1282.  
  1283. proc    CMDZERO;                    \COMMAND: ZERO
  1284. int    I;
  1285. begin
  1286. while CHAR=SP do NEXT;
  1287. if NUMERIC then ACTDEV:= NUMIN;
  1288. CHKDIR(ACTDEV);
  1289. TXT("ABOUT TO ZERO UNIT "); NUMOUT(DIRDEV); CROUT;
  1290. TITLE(63):= 0;            \MAKE SURE GARBAGE TITLE IS TERMINATED
  1291. TXT(TITLE); CROUT;
  1292.  
  1293. if not VERIFY then return;
  1294. for I:= 0,MAXFL do FSTAT(I):= NULL;
  1295. TITLE(0):= CR; TITLE(1):= 0;
  1296. FLAGS(7):= EXTPAT;        \ENABLE EXTENDED DIRECTORY
  1297. WRTDIR;
  1298. end;    \CMDZERO
  1299.  
  1300.  
  1301.  
  1302. proc    CMDDF;                        \COMMAND: DF
  1303. addr    BLOCK;
  1304.  
  1305.  
  1306.     proc    SHOW(STR,FLAG);
  1307.     addr    STR;
  1308.     int    FLAG;
  1309.     begin
  1310.     TXT(STR);
  1311.     CHOUT(0,if FLAG then ^T else ^F);
  1312.     end;    \SHOW
  1313.  
  1314.  
  1315. begin    \CMDDF
  1316. TXT("DEFAULT NAME:    ");
  1317. if CHAR=SP then
  1318.     begin
  1319.     NAME(RNAM+8, RDEV);
  1320.     BLOCK:= RESERVE(256);
  1321.     FREAD(SYSDEV, DIRBLK+3, BLOCK, 1);
  1322.  
  1323.     MOVENAME(LOCNAM, RNAM);
  1324.     MOVENAME(LOCNAM, BLOCK+$4D);
  1325.  
  1326.     RDEV:= LOCDEV;
  1327.     SYSPAG(DEFUNT):= LOCDEV;
  1328.     BLOCK($4A):= LOCDEV;
  1329.  
  1330.     FWRITE(SYSDEV, DIRBLK+3, BLOCK, 1);
  1331.     DIRDEV:= $FF;        \FORCE READ OF ALTERED DIRECTORY
  1332. end;
  1333. NUMOUT(RDEV); TXT(":"); PRNAME(RNAM); CROUT;
  1334. SHOW("BACKUP:    ", BAKFLG);
  1335. SHOW("    ABORT:    ", ABOFLG);
  1336. CROUT;
  1337. SHOW("PACK:    ", PAKFLG);
  1338. SHOW("    CHECK:    ", CHKFLG);
  1339. CROUT;
  1340. CROUT;
  1341. end;    \CMDDF
  1342.  
  1343.  
  1344.  
  1345. proc    CMDDO(FL);                    \COMMANDS: DO & NO
  1346. int    FL;
  1347. int    HASH;
  1348. begin
  1349. while CHAR=SP do NEXT;
  1350. HASH:= CHAR;
  1351. if CHAR#CR then NEXT else ERROR("NEED FLAG");
  1352. HASH:= HASH + SWAP(CHAR);
  1353.  
  1354. CHKDIR(SYSDEV);
  1355. case HASH of
  1356.   $4150\PA\: [FLAGS(0):= FL; PAKFLG:= FL];
  1357.   $4142\BA\: [FLAGS(1):= FL; BAKFLG:= FL];
  1358.   $4843\CH\: [FLAGS(2):= FL; CHKFLG:= FL];
  1359.   $4241\AB\: [FLAGS(5):= FL; ABOFLG:= FL]
  1360. other ERROR("FLAG DOES NOT EXIST");
  1361. WRTDIR;
  1362. end;    \CMDDO
  1363.  
  1364. \----------------------------------------------------------------------\
  1365.  
  1366. proc    CHKNAME;    \CHECK FOR VALID NAME IN "LOCNAM"
  1367. int    K;
  1368. begin
  1369. if (LOCNAM(8)=^B) & (LOCNAM(9)=^A) & (LOCNAM(10)=^K) then
  1370.     ERROR("YOU MAY NOT MAKE .BAK FILES");
  1371. for K:= 0,10 do
  1372.     if LOCNAM(K)=^? then
  1373.     ERROR("OUT FILE CANNOT HAVE ?'S OR *'S");
  1374. end;    \CHKNAME
  1375.  
  1376.  
  1377.  
  1378. proc    ENTER;
  1379. \ENTER A TENTATIVE OUTPUT FILE AND ITS BLOCKS INTO THE DIRECTORY.
  1380. \DON'T RESERVE THE BLOCKS, DON'T MARK IT VALID.
  1381. \IF "BACKUP" IS ENABLED, MARK IT "TENATIVE", OTHERWISE MARK IT "REPLACE".
  1382. \THE FILE WILL BE MARKED VALID AND BACKUPS WILL BE MAKE WHEN IT IS CLOSED.
  1383. begin
  1384. CHKNAME;
  1385.  
  1386. \FIND AN EMPTY DIR SLOT
  1387. FLNO:= 0;
  1388. while FSTAT(FLNO)=VALID do
  1389.     begin
  1390.     FLNO:= FLNO+1;
  1391.     if FLNO>MAXFL then
  1392.         ERROR("DIRECTORY IS FULL");
  1393.     end;
  1394. \NOW COPY THE NAME INTO IT
  1395. MOVENAME(LOCNAM, FNAME +FLNO*11);
  1396. PUT16(FBLK,FLNO,FIRBLK);
  1397. PUT16(LBLK,FLNO,LASBLK);
  1398. FSTAT(FLNO):= if (SPECIAL&1)&BAKFLG then TENTATIVE else REPLACE;
  1399. PUT16(FDATE, FLNO, if SPECIAL&4 then INDATE else SYSDAT);
  1400. end;    \ENTER
  1401.  
  1402. \----------------------------------------------------------------------\
  1403.  
  1404. proc    CLEAR(FILE);    \REMOVE AN ENTRY FROM THE DIRECTORY
  1405. int    FILE,MIN,MAX,I;
  1406. begin
  1407. if FSTAT(FILE)#VALID then return;
  1408. FSTAT(FILE):= NULL;
  1409. TXT("REMOVING ");
  1410. PRTDEV(FILE);
  1411. CROUT;
  1412. end;    \CLEAR
  1413.  
  1414.  
  1415.  
  1416. proc    REMOVE;        \REMOVE ANY COLLISIONS WITH "LOCNAM"
  1417. int    FILENO;
  1418. begin
  1419. FILENO:= LOOKUP(0);
  1420. if FILENO#NONE then CLEAR(FILENO);
  1421. end;    \REMOVE
  1422.  
  1423.  
  1424.  
  1425. proc    COPY(FRBLK,TOBLK,SIZE);    \(USED ONLY BY PACKING AND CHECKING)
  1426. int    FRBLK,TOBLK,SIZE,BUFSIZ,XFER;
  1427. addr    BUFFER;
  1428. begin            \CHECK ONLY IF TOBLK<0
  1429. if TOBLK>0 & FRBLK<TOBLK then ERROR("COPY TROUBLE");
  1430. BUFSIZ:= $40;
  1431. \BUFFER:= RESERVE($100 *BUFSIZ);
  1432.  
  1433. BUFFER:= $3000;        \WARNING! CLOBBERS USER SPACE ($3000 - $6FFF)
  1434. SWAPFLG:= false;    \INDICATE INVALID USER MEMORY
  1435.  
  1436. while SIZE > 0 do
  1437.     begin
  1438.     XFER:= if SIZE>BUFSIZ then BUFSIZ else SIZE;
  1439.     FREAD(LOCDEV,FRBLK,BUFFER,XFER);
  1440.     FRBLK:= FRBLK+XFER;
  1441.     if TOBLK >= 0 then
  1442.         begin
  1443.         FWRITE(LOCDEV,TOBLK,BUFFER,XFER);
  1444.         TOBLK:= TOBLK + XFER;
  1445.         end;
  1446.     SIZE:= SIZE-XFER;
  1447.     end;
  1448. end;    \COPY
  1449.  
  1450.  
  1451.  
  1452. proc    PACK(FILE);
  1453. int    FILE,SIZE;
  1454. begin
  1455. if not PAKFLG then return;        \RETURN IF PACK IS OFF
  1456. SIZE:= GET16(LBLK,FILE) - GET16(FBLK,FILE) + 1;
  1457. if FIND(SIZE) < SIZE then return;
  1458. if GET16(FBLK,FILE) <= FIRBLK then return;
  1459.                     \WE CAN PACK IT, SO...
  1460. TXT("PACKING: "); PRTDEV(FILE);
  1461. TXT("  TO: "); NUMOUT(FIRBLK); CROUT;
  1462.  
  1463. COPY(GET16(FBLK,FILE), FIRBLK, SIZE);
  1464. PUT16(FBLK, FILE, FIRBLK);
  1465. PUT16(LBLK, FILE, FIRBLK+SIZE-1);
  1466. end;    \PACK
  1467.  
  1468.  
  1469.  
  1470. proc    CLOFIL(FILE,PAF);
  1471. \CLOSE THE TENTATIVE FILE BY DIRECTORY NUMBER.
  1472. \ASSUME IT HAS BEEN ENTERED. REMOVE COLLISIONS.
  1473. int    FILE,PAF;
  1474. int    S;
  1475. begin
  1476. S:= FSTAT(FILE);
  1477. if S#TENTATIVE & S#REPLACE then
  1478.     begin
  1479.     TXT("
  1480. ???
  1481. ");
  1482.     return;
  1483.     end;
  1484. MOVENAME(FNAME +FILE*11, LOCNAM);
  1485. REMOVE;
  1486. FSTAT(FILE):= VALID;
  1487. TXT("CLOSING: ");
  1488. PRTDEV(FILE);
  1489. CROUT;
  1490. if PAF then PACK(FILE);
  1491. if CHKFLG then COPY(GET16(FBLK,FILE), -1, GET16(LBLK,FILE)-GET16(FBLK,FILE)+1);
  1492. end;    \CLOFIL
  1493.  
  1494. \----------------------------------------------------------------------\
  1495.  
  1496. proc    CMDSQ;                        \COMMAND: SQUASH
  1497. int    UBL, FILENO;
  1498. \THIS IS INEFFECIENT BECAUSE OF THE (STUPID) DIRECTORY SORT IN WRTDIR
  1499.  
  1500.  
  1501.     proc    SQ(FILENO);
  1502.     int    FILENO;
  1503.     int    FBL, LBL, SIZ, FL;
  1504.     begin
  1505.     FL:= STAB(FILENO);
  1506.     FBL:= GET16(FBLK, FL);
  1507.     LBL:= GET16(LBLK, FL);
  1508.     SIZ:= LBL - FBL + 1;
  1509.     if UBL < FBL then
  1510.         begin
  1511.         TXT("MOVING: "); PRTDEV(FL);
  1512.         TXT("  TO: "); NUMOUT(UBL);
  1513.         CROUT;
  1514.         COPY(FBL, UBL, SIZ);
  1515.         PUT16(FBLK, FL, UBL);
  1516.         PUT16(LBLK, FL, UBL+SIZ-1);
  1517.         WRTDIR;
  1518.         end;
  1519.     UBL:= GET16(LBLK, FL) + 1;
  1520.     end;    \SQ
  1521.  
  1522.  
  1523. begin    \CMDSQ
  1524. while CHAR=SP do NEXT;            \GET THE UNIT NUMBER, IF SPECIFIED
  1525. if NUMERIC then ACTDEV:= NUMIN;        \ AND READ IN THE DIRECTORY
  1526. CHKDIR(ACTDEV);                \MAKE SURE WE HAVE A VALID DIRECTORY
  1527. LOCDEV:= ACTDEV;            \(BECAUSE OF COPY)
  1528.  
  1529. UBL:= USERBLK;
  1530. for FILENO:= 0, MAXSTB do SQ(FILENO);
  1531.  
  1532. WRTDIR;
  1533. PUTDIR(ACTDEV,true);            \ALSO UPDATE BACKUP DIRECTORY
  1534. end;    \CMDSQ
  1535.  
  1536. \----------------------------------------------------------------------\
  1537.  
  1538. proc    CMDMAKE;                    \COMMAND: MAKE
  1539. int    K, FILENO, TEXT;
  1540. addr    BLOCK;
  1541. begin
  1542. CHKFILE;
  1543. NAME(RNAM+8,ACTDEV);
  1544.  
  1545. FILENO:= LOOKUP(0);
  1546. if FILENO#NONE then
  1547.     begin
  1548.     TXT("I WILL MUNCH OLD ONE! ");
  1549.     if not VERIFY then return else REMOVE;
  1550.     end;
  1551. if ARG1=NONE then
  1552.     begin
  1553.     ARG1:= 1;
  1554.     ARG2:= NONE;
  1555.     TEXT:= true;
  1556.     end
  1557. else TEXT:= false;
  1558.  
  1559. if ARG2=NONE then
  1560.     begin
  1561.     if FIND(ARG1) < ARG1 then
  1562.         ERROR("NOT ENOUGH SPACE ON THAT UNIT");
  1563.     LASBLK:= FIRBLK+ARG1-1;
  1564.     end
  1565. else    begin
  1566.     FIRBLK:= ARG2;
  1567.     LASBLK:= ARG2+ARG1-1;
  1568.     end;
  1569. ENTER;
  1570. CLOFIL(FLNO,false);        \(DON'T ALLOW PACKING)
  1571. WRTDIR;
  1572. if TEXT then
  1573.     begin
  1574.     BLOCK:= RESERVE(256);
  1575.     BLOCK(0):= $1A;
  1576.     FWRITE(LOCDEV,FIRBLK,BLOCK,1);    
  1577.     end;
  1578. end;    \CMDMAKE
  1579.  
  1580.  
  1581.  
  1582. proc    CMDDELETE;                    \COMMAND: DELETE
  1583. int    FLAG,FILENO;
  1584. begin
  1585. CHKFILE;
  1586. NAME("BAK",ACTDEV);
  1587. FLAG:= false;
  1588. FILENO:= LOOKUP(0);
  1589. while FILENO#NONE do
  1590.     begin
  1591.     CLEAR(FILENO);
  1592.     FLAG:= true;
  1593.     FILENO:= LOOKUP(FILENO+1);
  1594.     end;
  1595. if FLAG then
  1596.     begin
  1597.     if VERIFY then WRTDIR else RDDIR(LOCDEV);
  1598.     end
  1599. else ERROR("NO SUCH FILES FOUND");
  1600. end;    \CMDDELETE
  1601.  
  1602.  
  1603.  
  1604. proc    CMDSAVE;                    \COMMAND: SAVE
  1605. \SAVE THE CURRENT MEMORY IMAGE. NOTE THAT PART OF IT MAY BE IN SCRATCH.SYS
  1606. int    SIZE, BLOCK, A;
  1607. begin
  1608. CHKFILE;
  1609. NAME("SAV",ACTDEV);
  1610. if not SWAPFLG then
  1611.     begin
  1612.     TXT("SAVED AREA MAY NOT BE VALID");
  1613.     if not VERIFY then REBEGIN;
  1614.     end;
  1615. BLOCK:= RESERVE(256);
  1616. FREAD(SYSDEV,SWPBLK(0),BLOCK,1);        \GET SYSPAG FROM SCRATCH.SYS
  1617. if ARG1#NONE then
  1618.     begin
  1619.     if ARG2=NONE then
  1620.         ERROR("NEED ENDING ADDRESS");
  1621.     if ARG1 >= ARG2 then                    \%%%
  1622.         ERROR("ILLEGAL ADDRESS RANGE");
  1623.     A:= BLOCK + USRMEM - SYSPAG;
  1624.     A(0):= ARG1;
  1625.  
  1626.     SIZE:= (ARG2-ARG1)/256 +1;    \SIZE IN BLOCKS OF .SAV FILE
  1627.     A:= BLOCK + PROSIZ - SYSPAG;    \ NOT INCLUDING SYSPAG
  1628.     A(0):= SIZE;
  1629.  
  1630.     FWRITE(SYSDEV,SWPBLK(0),BLOCK,1);
  1631.     end;
  1632. A:= BLOCK + PROSIZ - SYSPAG;
  1633. SIZE:= A(0) +1;                \SIZE IN BLOCKS INCLUDING SYSPAG
  1634. CHKDIR(LOCDEV);
  1635. if FIND(SIZE)<SIZE then ERROR("NOT ENOUGH SPACE ON THAT UNIT");
  1636. LASBLK:= FIRBLK+SIZE-1;
  1637. ENTER;                    \RECORD .SAV FILE IN THE DIRECTORY
  1638. WRTDIR;
  1639. SYSPAG(INFLG):= NOFILE;
  1640. SYSPAG(INNO):= FLNO;
  1641. SYSPAG(INUNT):= LOCDEV;
  1642. FSAVE(LOCDEV,FIRBLK);
  1643. \This last statement does not return directly. It loads SCRATCH.SYS into
  1644. \ memory then writes the .SAV file. It restarts Apex with a "re-entry"
  1645. \ condition which ultimately runs FIXSAV.
  1646. end;    \CMDSAVE
  1647.  
  1648. \----------------------------------------------------------------------\
  1649.  
  1650. proc    OPENOT;
  1651. \IF SWITCH IS "R", THEN OPEN EXISTING FILE ELSE OPEN A SUITABLE TENTATIVE
  1652. \ AS AN OUTPUT FILE FOR THE USER. USE THE NAME IN "LOCNAM".
  1653. int    FILENO,SIZE,TARGSIZ,MINSIZ;
  1654. begin
  1655. if LOCNAM(0)=SP then return;
  1656. CHKDIR(LOCDEV);
  1657. if SWITCH=^R then
  1658.     begin
  1659.     \(NOTE THAT THE FILE MAY BE WRITTEN EVEN IF IT IS NOT CLOSED)
  1660.     FILENO:= LOOKUP(0);
  1661.     if FILENO=NONE then FILERR;
  1662.     PUT16(FDATE, FILENO, SYSDAT);
  1663.     WRTDIR;
  1664.     OTLBLK(0):= GET16(FBLK,FILENO);                \%%%
  1665.     OTHBLK(0):= GET16(LBLK,FILENO);                \%%%
  1666.     end
  1667. else    begin
  1668.     \if INSIZE>0 then TARGSIZ:= INSIZE+(INSIZE/2)+10
  1669.     \else TARGSIZ:= (GET16(LEMBLK,0) - GET16(FEMBLK,0) + 1) /2;
  1670.  
  1671.     MINSIZ:= 1;
  1672.     if (SPECIAL&2) & (INSIZE>0) then MINSIZ:= INSIZE+1;    \IF SIZE LIMIT
  1673.     if ARG1#NONE then [MINSIZ:= ARG1; TARGSIZ:= MINSIZ];
  1674.  
  1675.     \SIZE:= FIND(TARGSIZ);
  1676.     SIZE:= FIND(32767);    \USE THE BIGGEST AVAIL--THE HELL WITH BISECTION
  1677.     ENTER;
  1678.     if SIZE<MINSIZ then ERROR("OUT FILE IS TOO SMALL");
  1679.     WRTDIR;
  1680.     OTLBLK(0):= FIRBLK;                    \%%%
  1681.     OTHBLK(0):= LASBLK;                    \%%%
  1682.     FILENO:= FLNO;
  1683.     end;
  1684.  
  1685. SYSPAG(OTFLG):= SETUP;
  1686. SYSPAG(OTNO):= FILENO;
  1687. SYSPAG(OTUNT):= LOCDEV;
  1688. TXT("OUTFILE: "); PRTDEV(FILENO); CROUT;
  1689.  
  1690. PUTDIR(DIRDEV,true);        \UPDATE BACKUP DIRECTORY
  1691. end;    \OPENOT
  1692.  
  1693.  
  1694.  
  1695. proc    OPENIN;        \OPEN USER'S INPUT FILE
  1696. int    FILENO;
  1697. begin
  1698. \OPEN USER'S INPUT FILE
  1699. if LOCNAM(0)=SP then return;
  1700. CHKDIR(LOCDEV);
  1701. FILENO:= LOOKUP(0);
  1702. if FILENO=NONE then FILERR;
  1703. INLBLK(0):= GET16(FBLK,FILENO);                    \%%%
  1704. INHBLK(0):= GET16(LBLK,FILENO);                    \%%%
  1705. SYSPAG(INFLG):= SETUP;
  1706. SYSPAG(INNO):= FILENO;
  1707. SYSPAG(INUNT):= LOCDEV;
  1708. INSIZE:= GET16(LBLK,FILENO) - GET16(FBLK,FILENO) +1;
  1709. INDATE:= GET16(FDATE,FILENO);
  1710. TXT(" INFILE: "); PRTDEV(FILENO); CROUT;
  1711. end;    \OPENIN
  1712.  
  1713.  
  1714.  
  1715. proc    CMDOPEN(DEFO,DEFI);                \COMMAND: OPEN
  1716. \"@" means replace with another extension. If the operator doesn't type one in,
  1717. \ then use the default extension (set by "SET"). If the default extension is
  1718. \ "@@@", then use the system-wide default extension.
  1719. addr    DEFO,DEFI,OUTNAM;
  1720. int    I,OUTDEV,INFL,OTFL, FLIPFL, T, GOTFL;
  1721. begin
  1722. OUTNAM:= RESERVE(11);
  1723. if DEFO(0)=SP & DEFI(0)=SP then return;
  1724. if CHAR#SP then return;    \("CHKFILE" IS NOT USED BECAUSE OF "PNTDIR", ETC.)
  1725. NEXT;            \SKIP THE SPACE AFTER "OPEN"
  1726.  
  1727. OTFL:= false; INFL:= false;
  1728. GOTFL:= CHAR=SP;
  1729. NAME("@@@",ACTDEV);
  1730. if GOTFILE ! GOTFL then OTFL:= true;
  1731.  
  1732. FLIPFL:= CHAR=^>;
  1733. if CHAR=^< ! FLIPFL then
  1734.     begin                \GET INPUT FILE NAME
  1735.     MOVENAME(LOCNAM, OUTNAM);
  1736.     OUTDEV:= LOCDEV;
  1737.     NEXT;
  1738.     GOTFL:= CHAR=SP;
  1739.     NAME("@@@",ACTDEV);
  1740.     if GOTFILE ! GOTFL then INFL:= true;
  1741.     end
  1742. else    begin                \INFILE = OUTFILE
  1743.     MOVENAME(LOCNAM, OUTNAM);
  1744.     OUTDEV:= LOCDEV;
  1745.     if DEFO(0)#^@ then
  1746.         for I:= 0,2 do OUTNAM(I+8):= DEFO(I);
  1747.     INFL:= true;
  1748.     OTFL:= true;
  1749.     end;
  1750.  
  1751. if FLIPFL then
  1752.     begin            \FLIP (SWAP) INPUT AND OUTPUT FILES
  1753.     T:= INFL; INFL:= OTFL; OTFL:= T;
  1754.     T:= LOCDEV; LOCDEV:= OUTDEV; OUTDEV:= T;
  1755.     for I:= 0,10 do
  1756.         [T:= LOCNAM(I); LOCNAM(I):= OUTNAM(I); OUTNAM(I):= T];
  1757.     end;
  1758.  
  1759. if LOCNAM(8)=^@ then            \GET INFILE EXTENSION
  1760.     if DEFI(0)#^@ then for I:= 0,2 do LOCNAM(8+I):= DEFI(I)
  1761.     else for I:= 8,10 do LOCNAM(I):= RNAM(I);
  1762. if INFL & (DEFI(0)#SP) then OPENIN;
  1763.  
  1764. if OUTNAM(8)=^@ then            \GET OUTFILE EXTENSION
  1765.     if DEFO(0)#^@ then for I:= 0,2 do OUTNAM(8+I):= DEFO(I)
  1766.     else for I:= 8,10 do OUTNAM(I):= RNAM(I);
  1767. MOVENAME(OUTNAM, LOCNAM);
  1768. LOCDEV:= OUTDEV;
  1769. if OTFL & (DEFO(0)#SP) then OPENOT;
  1770. end;    \CMDOPEN
  1771.  
  1772.  
  1773.  
  1774. proc    CMDCLOSE;                    \COMMAND: CLOSE
  1775. int    I,FL,RSAV,FILENO;
  1776. begin
  1777. ACTDEV:= SYSPAG(OTUNT);            \GET OUTPUT FILE UNIT NUMBER
  1778. LOCDEV:= ACTDEV;
  1779. CHKDIR(ACTDEV);
  1780. FL:= SYSPAG(OTNO);
  1781. if FSTAT(FL)=TENTATIVE then
  1782.     begin
  1783.     MOVENAME(FNAME +FL*11, LOCNAM);
  1784.     FILENO:= LOOKUP(0);
  1785.     if FILENO#NONE then
  1786.         begin
  1787.         \RESOLVE THE COLLISION
  1788.         RSAV:= FILENO;
  1789.         LOCNAM(8):= ^B; LOCNAM(9):= ^A; LOCNAM(10):= ^K;
  1790.         FILENO:= LOOKUP(0);
  1791.         if FILENO#NONE then CLEAR(FILENO);
  1792.         TXT("BACKING: "); PRTDEV(RSAV); CROUT;
  1793.         I:= RSAV*11+8;
  1794.         FNAME(I):= ^B;
  1795.         FNAME(I+1):= ^A;
  1796.         FNAME(I+2):= ^K;
  1797.         end;
  1798.     end
  1799. else if FSTAT(FL)#REPLACE then
  1800.     begin
  1801.     TXT("OUTPUT FILE NOT OPEN
  1802. ");
  1803.     return;
  1804.     end;
  1805. PUT16(LBLK, FL, OTHBLK(0));
  1806. CLOFIL(FL,true);
  1807. WRTDIR;
  1808. end;    \CMDCLOSE
  1809.  
  1810. \----------------------------------------------------------------------\
  1811.  
  1812. proc    CMDLIST;                    \COMMAND: LIST
  1813. int    CHAR, DEV, BLK, HBLK, SIZ, I;
  1814. addr    BUFFER;
  1815. begin
  1816. CHKFILE;
  1817. CMDOPEN("   ","@@@");
  1818. if SYSPAG(INFLG)#SETUP then FILERR;
  1819.  
  1820. \(DISK BUFFERING IS DONE THIS WAY TO AVOID TYING UP MEMORY WITH AN INPUT BUFFER)
  1821. DEV:= SYSPAG(INUNT);
  1822. BLK:= INLBLK(0);
  1823. HBLK:= INHBLK(0);
  1824. BUFFER:= RESERVE(4*BLKSIZ);
  1825.  
  1826. OPENI(1);
  1827. LINECTR:= 1;
  1828. loop    begin
  1829.     SIZ:= 4;            \DON'T READ BEYOND END OF UNIT
  1830.     if HBLK-BLK < 3 then SIZ:= HBLK -BLK +1;
  1831.      FREAD(DEV, BLK, BUFFER, SIZ);
  1832.     BLK:= BLK+4;
  1833.     for I:= 0,1023 do
  1834.         begin
  1835.         CHAR:= BUFFER(I);
  1836.         if CHAR>=$20 then CHOUT(0,CHAR)    \(FOR SPEED)
  1837.         else    case CHAR of
  1838.               CR: CROUTX;
  1839.               LF: ;                \IGNORE THE DAMN THINGS
  1840.               FF: [CROUTX; CROUTX; CROUTX];    \DON'T ERASE ANYTHING
  1841.               EOF: quit
  1842.             other CHOUT(0,CHAR);
  1843.         end;
  1844.     end;
  1845. CROUTX;
  1846. SYSPAG(OTFLG):= NOFILE;
  1847. SYSPAG(INFLG):= NOFILE;
  1848. end;    \CMDLIST
  1849.  
  1850.  
  1851.  
  1852. proc    CMDRENAME;                    \COMMAND: RENAME
  1853. \RENAME NAMEOLD TO BE NAMENEW     NAMENEW<NAMEOLD     NAMEOLD>NAMENEW
  1854. int    I, T, FILENO, DEV, FLIPFL, GOTFL, COUNT;
  1855. addr    NAMENEW, NAMEOLD, NAME2NEW, NAME2OLD;
  1856. begin
  1857. NAMENEW:= RESERVE(11);
  1858. NAMEOLD:= RESERVE(11);
  1859. NAME2NEW:= RESERVE(11);
  1860. NAME2OLD:= RESERVE(11);
  1861.  
  1862. CHKFILE;
  1863. NAME(RNAM+8,ACTDEV);
  1864. MOVENAME(LOCNAM, NAMENEW);    \NAMENEW := LOCNAM
  1865. if (CHAR#^< & CHAR#^>) then ERROR("UNCLEAR SYNTAX");
  1866. FLIPFL:= CHAR=^>;
  1867.  
  1868. DEV:= LOCDEV;
  1869. NEXT;
  1870. GOTFL:= CHAR=SP;
  1871. NAME(RNAM+8,DEV);
  1872. MOVENAME(LOCNAM, NAMEOLD);
  1873. if DEV#LOCDEV then ERROR("CANNOT CHANGE UNIT");
  1874. if not GOTFL & not GOTFILE then ERROR("NEED FILE NAME");    \(SPACE IS OK)
  1875. if FLIPFL then
  1876.     begin        \SWAP (FLIP) OLD AND NEW
  1877.     MOVENAME(NAMENEW, NAME2NEW);
  1878.     MOVENAME(NAMEOLD, NAMENEW);
  1879.     MOVENAME(NAME2NEW, NAMEOLD);
  1880.     end;
  1881.  
  1882. COUNT:= 0;
  1883. MOVENAME(NAMEOLD, LOCNAM);    \LOOKUP THE OLD, EXISTING NAME(S)
  1884. FILENO:= LOOKUP(0);
  1885. while FILENO#NONE do        \FOR ALL OF THE OLD, EXISTING NAMES...
  1886.     begin
  1887.     COUNT:= COUNT+1;
  1888.     \REPLACE ?'S IN THE NEW NAME WITH CORRESPONDING CHAR IN OLD NAME
  1889.     MOVENAME(FNAME +FILENO*11, NAME2OLD);    \GET THE EXISTING NAME
  1890.     MOVENAME(NAMENEW, NAME2NEW);
  1891.     for I:= 0,10 do
  1892.         if NAME2NEW(I)=^? then NAME2NEW(I):= NAME2OLD(I);
  1893.  
  1894.     \DON'T ALLOW: RENAME SAMENAME.SSS<*.*
  1895.     MOVENAME(NAME2NEW, LOCNAM);
  1896.     if LOOKUP(0)#NONE then ERROR("FILE NAME IS USED");
  1897.  
  1898.     TXT(" RENAME: "); PRTDEV(FILENO); CROUT;
  1899.     MOVENAME(NAME2NEW, FNAME +FILENO*11);
  1900.     TXT("  TO BE: "); PRTDEV(FILENO); CROUT;
  1901.  
  1902.     MOVENAME(NAMEOLD, LOCNAM);    \LOOKUP THE OLD, EXISTING NAME(S)
  1903.     FILENO:= LOOKUP(FILENO+1);
  1904.     end;
  1905.  
  1906. if COUNT=0 then FORMERR;
  1907. if COUNT>=2 then
  1908.     [if VERIFY then WRTDIR else DIRDEV:= $FF]
  1909. else    WRTDIR;
  1910. end;    \CMDRENAME
  1911.  
  1912. \----------------------------------------------------------------------\
  1913.  
  1914. proc    CMDUNLOCK(BOOL);                \COMMANDS: LOCK & UNLOCK
  1915. int    BOOL;        \UNLOCK IF TRUE
  1916. begin
  1917. while CHAR=SP do NEXT;
  1918. if NUMERIC then ACTDEV:= NUMIN;
  1919. MAXTBL(ACTDEV):= $7FFF;            \ALLOW THE READ NO MATTER WHAT    ????
  1920. CHKDIR(ACTDEV);
  1921. FLAGS(3):= BOOL;            \SET FLAG AS WE WILL WANT IT
  1922.  
  1923. SYSPAG(LOKMSK):= SYSPAG(LOKMSK) ! BITS(ACTDEV);    \UNLOCK FOR THIS WRITE
  1924. if MAXBLK<16 then PUT16(PMAXB, 0, 16);        \FORCE MINIMUM SIZE
  1925. MAXTBL(DIRDEV):= $7FFF;            \ALLOW THIS WRITE
  1926. PUTDIR(DIRDEV,false);            \(ALL TO SET ONE BYTE)
  1927.  
  1928. RDDIR(ACTDEV);                \SET "LOKMSK" (THE HARD WAY)
  1929. TXT("UNIT "); NUMOUT(ACTDEV); TXT(" IS ");
  1930. if FLAGS(3) then TXT("UNLOCKED") else TXT("WRITE LOCKED");
  1931. CROUT;
  1932. end;    \CMDUNLOCK
  1933.  
  1934.  
  1935.  
  1936. proc    CMDSUB;                        \COMMAND: SUB
  1937. int    FILE, SIZE;
  1938. begin
  1939. NAME("SBD",ACTDEV);
  1940. LOCNAM(8):= ^S;            \MAKE SURE IT'S A SUB-DIRECTORY
  1941. LOCNAM(9):= ^B;
  1942. LOCNAM(10):= ^D;
  1943. if GOTFILE then            \IF WE'VE GOT A FILE (NOT JUST A SPACE) THEN
  1944.     begin            \ MOVE TO SUB-DIRECTORY
  1945.     CHKDIR(LOCDEV);
  1946.     FILE:= LOOKUP(0);
  1947.     if FILE=NONE then ERROR("NO SUCH SUB-DIRECTORY");
  1948.  
  1949.     OFFTBL(LOCDEV):= OFFTBL(LOCDEV) + GET16(FBLK,FILE);
  1950.  
  1951.     SIZE:= GET16(LBLK,FILE) - GET16(FBLK,FILE) + 1;
  1952.     MAXTBL(LOCDEV):= OFFTBL(LOCDEV) + SIZE;        \SO WE CAN DIDDLE
  1953.  
  1954.     RDDIR(LOCDEV);            \NOW FORCE SIZE TO BE CORRECT
  1955.     if SIZE#MAXBLK+1 then
  1956.         begin
  1957.         TXT("HEY! SIZE IS WRONG. I WILL FIX IT."); CROUT;    \????
  1958.         MAXTBL(LOCDEV):= OFFTBL(LOCDEV) + SIZE;    \SO WE CAN DIDDLE
  1959.         if FLAGS(3) then
  1960.             begin
  1961.             MAXBLK:= SIZE-1;
  1962.             PUT16(PMAXB, 0, MAXBLK);
  1963.             WRTDIR;
  1964.             RDDIR(LOCDEV);        
  1965.             end
  1966.         else    begin
  1967.             TXT("OOPS! I CAN'T, YOU LOCKED IT!"); CROUT;
  1968.             end;
  1969.         end;
  1970.     TXT("THE DEED IS DONE. SIZE: ");
  1971.     NUMOUT(MAXTBL(LOCDEV) - OFFTBL(LOCDEV)); CROUT;
  1972.     end
  1973. else    begin                \RESTORE TO PARENT DIRECTORY
  1974.     OFFTBL(LOCDEV):= 0;
  1975.     RDDIR(LOCDEV);
  1976.     MAXTBL(LOCDEV):= MAXBLK +1;
  1977.     TXT("UNIT "); NUMOUT(LOCDEV); TXT(" RESET. SIZE: ");
  1978.     NUMOUT(MAXTBL(LOCDEV) - OFFTBL(LOCDEV)); CROUT;
  1979.     end;
  1980. end;    \CMDSUB
  1981.  
  1982. \----------------------------------------------------------------------\
  1983.  
  1984. proc    FIXSAV;        \CLOSE THE .SAV FILE STARTED FROM "CMDSAVE"
  1985. \THIS PROCEDURE CANNOT BE CALLED DIRECTLY FROM "CMDSAVE" BECAUSE APEX MAY
  1986. \ NOT BE IN MEMORY WHEN THE .SAV FILE IS WRITTEN.
  1987. int    FL;
  1988. begin
  1989. LOCDEV:= SYSPAG(INUNT);
  1990. CHKDIR(LOCDEV);
  1991. FL:= SYSPAG(INNO);
  1992. CLOFIL(FL,false);        \(PACKING IS UNNECESSARY BECAUSE .SAV FILE
  1993. WRTDIR;                \ IS PUT INTO THE FIRST BIGGEST EMPTY LOCATION
  1994. end;    \FIXSAV
  1995.  
  1996.  
  1997.  
  1998. func    LOOKER(DEV);
  1999. \A RECURSIVE ROUTINE TO SEARCH ALL SUB-DIRECTORIES ON A UNIT AND RETURN
  2000. \ THE FIRST BLOCK OF A FILE (RELATIVE TO THE DIRECTORY AT THE TIME OF CALL).
  2001. int    DEV;
  2002. int    FILE,HOLDAD,REPLY,FIRBLK,BASEAD;
  2003. addr    HOLD,SBDNAM;
  2004. begin
  2005. LOCDEV:= DEV;
  2006. FILE:= LOOKUP(0);
  2007. if FILE#NONE then return GET16(FBLK,FILE);
  2008. \TRIVIAL CASE TAKEN CARE OF, SO GO ONE DEEPER
  2009.  
  2010. HOLD:= RESERVE(11);
  2011. MOVENAME(LOCNAM, HOLD);
  2012. SBDNAM:= "????????SBD";
  2013. HOLDAD:= OFFTBL(DEV);
  2014. FILE:= -1;
  2015. loop    begin                    \LOOK FOR A SBD
  2016.     MOVENAME(SBDNAM, LOCNAM);
  2017.     FILE:= LOOKUP(FILE+1);
  2018.     if FILE=NONE then [REPLY:= NONE; quit];
  2019.                         \FOUND ONE SO SUB TO IT
  2020.     BASEAD:= GET16(FBLK,FILE);
  2021.     OFFTBL(DEV):= BASEAD + OFFTBL(DEV);
  2022.     RDDIR(DEV);
  2023.                         \AND RECURSE
  2024.     MOVENAME(HOLD, LOCNAM);
  2025.     FIRBLK:= LOOKER(DEV);
  2026.     if FIRBLK#NONE then [REPLY:= FIRBLK+BASEAD; quit];
  2027.     OFFTBL(DEV):= HOLDAD;
  2028.     RDDIR(DEV);
  2029.     end;
  2030.  
  2031. OFFTBL(DEV):= HOLDAD;
  2032. RDDIR(DEV);
  2033. MOVENAME(HOLD, LOCNAM);
  2034. return REPLY;
  2035. end;    \LOOKER
  2036.  
  2037.  
  2038.  
  2039. proc    DOCMD(BLK);    \EXECUTE A .CMD FILE BEGINNING AT BLOCK "BLK"
  2040. int    BLK;
  2041. int    I,J,K,CH,ARGSIZ;
  2042. addr    BLOCK,ARG;
  2043.  
  2044.  
  2045.     proc    INSERT(CH);
  2046.     int    CH;
  2047.     begin
  2048.     if CH=LF then return;
  2049.     if I>254 then ERROR(".CMD FILE IS TOO BIG");
  2050.     CMDBUF(I):= CH;
  2051.     I:= I+1;
  2052.     end;    \INSERT
  2053.  
  2054.  
  2055. begin    \DOCMD
  2056. ARG:= RESERVE(80);
  2057. while CHAR=SP do NEXT;        \("1:#" WON'T WORK OTHERWISE)
  2058. I:= 0;
  2059. while CHAR#CR do        \GET ARGUMENT (IF ANY) FROM COMMAND LINE
  2060.     begin
  2061.     if I<79 then [ARG(I):= CHAR; I:= I+1];
  2062.     NEXT;
  2063.     end;
  2064. ARGSIZ:= I-1;
  2065.  
  2066. BLOCK:= RESERVE(256);
  2067. FREAD(ACTDEV,BLK,BLOCK,1);        \READ IN .CMD FILE
  2068. J:= 0; I:= 0;
  2069. repeat    begin
  2070.     CH:= BLOCK(J); J:= J+1;
  2071.     case CH of
  2072.       ^#:     for K:= 0,ARGSIZ do INSERT(ARG(K));    \INSERT ARGUMENT
  2073.       ^^:    begin                    \INSERT CTRL CHAR
  2074.         CH:= BLOCK(J); J:= J+1;
  2075.         if CH>=$40 then INSERT(CH-$40);
  2076.         end
  2077.     other INSERT(CH);
  2078.     end
  2079. until CH=EOF;
  2080. SYSPAG(CMDMODE):= true;
  2081. CMDPTR(0):= CMDBUF;
  2082. REBEGIN;
  2083. end;    \DOCMD
  2084.  
  2085.  
  2086.  
  2087. proc    RUN(BLK);    \RUN A .SAV FILE BEGINNING AT BLOCK "BLK"
  2088. int    BLK;
  2089. int    FIRBLK,I,DEV;
  2090. addr    BLOCK,DEFO,DEFI;
  2091. begin
  2092. if BLK=NONE then return;
  2093. BLOCK:= RESERVE(256);
  2094. DEFO:= RESERVE(3);
  2095. DEFI:= RESERVE(3);
  2096. FREAD(ACTDEV,BLK,BLOCK,1);
  2097. for I:= 0,2 do [DEFO(I):= BLOCK(DEXTO+I)];
  2098. for I:= 0,2 do [DEFI(I):= BLOCK(DEXTI+I)];
  2099. SPECIAL:= BLOCK(DEFAUL);
  2100. DEV:= ACTDEV;
  2101. ACTDEV:= RDEV;
  2102. CMDOPEN(DEFO,DEFI);
  2103. CROUT;
  2104. FRUN(DEV,BLK);        \(NEVER RETURNS)
  2105. end;    \RUN
  2106.  
  2107. \======================================================================\
  2108.  
  2109. begin    \MAIN
  2110. BITS:= [$01,$02,$04,$08,$10,$20,$40,$80];
  2111. MOSTR:= "JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC";
  2112. DIRLEN:= [24, 48, 48, 6, 6, 24, 8, 16, 16, 48, 4];
  2113. CHAR:= CR;
  2114.  
  2115. SYSPAG:= $0400;                \LOCATION OF RESIDENT SYSTEM PAGE
  2116. USRMEM:= $432;                \ABSOLUTE ADDRESSES IN SYSTEM PAGE
  2117. PROSIZ:= $436;
  2118. SYSBLK:= $502;
  2119. SWPBLK:= $506;
  2120. OTLBLK:= $556;
  2121. OTHBLK:= $55A;
  2122. INLBLK:= $562;
  2123. INHBLK:= $566;
  2124. MAXTBL:= $0586;
  2125. OFFTBL:= $05C6;
  2126.  
  2127. CONWID:= 80;                \GET CONSOLE DIMENSIONS
  2128. CONHT:= 24;
  2129.  
  2130. CMDPTR:= $698;
  2131. CMDBUF:= $6A8;
  2132.  
  2133. BLKSIZ:= 256;                \SIZE OF A BLOCK IN BYTES
  2134. DIRBLK:= 9;                \LOCATION OF DIRECTORY BLOCK
  2135. DIRSIZ:= 4;                \SIZE OF DIRECTORY IN "BLKSIZ" BLOCKS
  2136. BACKBLK:= DIRBLK + DIRSIZ;        \LOCATION OF BACKUP DIRECTORY
  2137. USERBLK:= BACKBLK + DIRSIZ;        \START OF USER FILE SPACE
  2138.  
  2139. MAXFL:= 95;                \SELECT SO THAT DIRSIZ IS RIGHT
  2140.  
  2141.                     \RESERVE THE ARRAYS
  2142. II:= (MAXFL+1)*2;
  2143.                     \BLOCKS 0-2
  2144. FNAME:= RESERVE(8*BLKSIZ);                    \%%%
  2145. FSTAT:= FNAME + ((MAXFL+1)*11);
  2146. FBLK:= FSTAT + (MAXFL+1);
  2147. LBLK:= FBLK + (II);
  2148.                     \BLOCK 3
  2149. FEMBLK:= LBLK + (II);
  2150. LEMBLK:= FEMBLK + (24);
  2151. STAB:= LEMBLK + (24);
  2152. NUMVAL:= STAB + (MAXFL+1);
  2153. DIRCHG:= NUMVAL + (1);
  2154. PRDEV:= DIRCHG + (1);
  2155. PMAXB:= PRDEV + (1);
  2156. DFNAME:= PMAXB + (2);
  2157. UNUSED:= DFNAME + (11);
  2158. TITLE:= UNUSED + (16);
  2159. UNUSED:= TITLE + (64);
  2160. APEXID:= UNUSED + (24);
  2161. VOLUME:= APEXID + (4);
  2162. DIRDAT:= VOLUME + (2);
  2163. UNUSED:= DIRDAT + (2);
  2164. FDATE:= UNUSED + (32);
  2165. FLAGS:= FDATE + (II);
  2166. \FLAGS + (16);
  2167.                     \NON-DIR ARRAYS:
  2168. LOCNAM:= RESERVE(11);
  2169. RNAM:= RESERVE(11);
  2170.  
  2171. OPENI(0);   OPENO(0);
  2172.  
  2173. \There are these ways in which this program may have been entered:
  2174. \A) Cold reboot from power off. In that case we expect that the
  2175. \   system will have loaded with an invalid system date. The flag COLD
  2176. \   is used to identify this state.
  2177. \B) We could have been re-entered after an error dropout (REBEGIN). In this
  2178. \   case only, the RERUN flag will be true.
  2179. \C) We could have been entered from the resident code, with or
  2180. \   without a reload. The resident code provides the flag SYSENF (system entry
  2181. \   flag) to distinguish these:
  2182. \    RELOAD=$FC == reloaded from scratch (no history)
  2183. \    RENTER=$FD == re-entered without saving the swap space.
  2184. \    SAVER=$FE == reloaded after saving swap space into "SCRATCH.SYS".
  2185. \    FSAVE=$FF == reloaded after writing a .SAV file to disk.
  2186. \    FASAVE=$F0 == reloaded after writing "SYSTEM.SYS"
  2187.  
  2188. \IS THIS A COLD START REBOOT?
  2189. COLD:= not (SYSPAG(DATOFF) & SYSPAG(DATOF1));
  2190. COLD:= (SYSPAG(DATOF2) # (COLD&$FF));
  2191. if COLD then
  2192.     begin
  2193.     CHOUT(0,FF);
  2194.     TXT("
  2195.  
  2196.         A P E X
  2197.        / \
  2198.       /   \
  2199.  
  2200.      BY
  2201.  
  2202. COMPUTER APPLICATIONS
  2203. 4334 EAST 17TH AVENUE
  2204. DENVER COLORADO 80220
  2205.  
  2206.  
  2207. TYPE ^"HELP^" FOR INSTRUCTIONS
  2208.  
  2209. ");
  2210.     end
  2211. else CROUT;
  2212.  
  2213. if not RERUN then        \NOT AN ERROR RESTART--SHOW WE'RE BACK IN APEX
  2214.     [TXT("-- APEX, V1.8x18 --"); CROUT];
  2215.  
  2216. CMDNEW(SYSPAG(SYSUNT));
  2217. SYSDAT:= SYSPAG(DATOFF) + SWAP(SYSPAG(DATOF1));
  2218.  
  2219. if SYSPAG(SYSENF) = RELOAD then
  2220.     [TXT("RELOADED FROM UNIT "); NUMOUT(SYSDEV); CROUT];
  2221.  
  2222. if SYSPAG(OTFLG)=CLOSED then        \CLOSE ANY NEW TENTATIVES LYING AROUND
  2223.     [CMDCLOSE; SYSPAG(OTFLG):= NOFILE];
  2224.  
  2225. SWAPFLG:= false;
  2226. if SYSPAG(SYSENF)=SAVEIN then        \WE HAVE A .SAV FILE TO UPDATE
  2227.     [FIXSAV; SWAPFLG:= true];    \OUR SWAP AREA MUST BE VALID
  2228. if SYSPAG(SYSENF)=SWAPIN then
  2229.     SWAPFLG:= true;
  2230.  
  2231. SYSPAG(OTFLG):= NOFILE; SYSPAG(INFLG):= NOFILE;    \ERASE ANY OPEN FILES
  2232.  
  2233. \NOW CHECK FOR UNITS NEEDING ATTENTION:
  2234. \REMOVED - SEE RDDIR
  2235. \++for II:= 0,7 do if (SYSPAG(UNTUPD) & BITS(II))#0 then RDDIR(II);
  2236.         
  2237. if COLD then
  2238.     begin                \IF COLD START, RUN "STARTUP.CMD"
  2239.     COLD:= false;
  2240.     SYSPAG(SYSENF):= 0;
  2241.     ACTDEV:= SYSDEV;
  2242.     FILENO:= FINDFL(SYSDEV,"STARTUP CMD");
  2243.     if FILENO#NONE then DOCMD(GET16(FBLK,FILENO));
  2244.     end;
  2245.  
  2246. loop    begin                \COMMAND DECODER
  2247.     SWITCH:= SP;
  2248.     SPECIAL:= 1;
  2249.     INSIZE:= 0;
  2250.     INDATE:= SYSDAT;        \DEFAULT DATE
  2251.     TXT("APX>");
  2252. \    OPENI(0);
  2253.     NEXT;
  2254.     NAME("CMD",SYSDEV);
  2255.     if GOTFILE then
  2256.         begin            \IS COMMAND
  2257.         ACTDEV:= LOCDEV;
  2258.         if SWITCH#^E & LOCNAM(8)=^C & LOCNAM(9)=^M & LOCNAM(10)=^D then
  2259.             begin
  2260.             FILENO:= LOOKUP(0);
  2261.             if FILENO#NONE then DOCMD(GET16(FBLK,FILENO));
  2262.             end;
  2263.  
  2264.         LOCNAM(8):= ^S;        \FORCE IT TO A ".SAV" FILE
  2265.         LOCNAM(9):= ^A;
  2266.         LOCNAM(10):= ^V;
  2267.         FILENO:= LOOKUP(0);
  2268.         if FILENO#NONE then RUN(GET16(FBLK,FILENO));    \(NEVER RETURNS)
  2269.     
  2270.         if DRVSET then
  2271.             begin        \TRY A DEEP SEARCH ON THE SYSTEM UNIT
  2272.             if ACTDEV#SYSDEV then FILERR;
  2273.             RUN(LOOKER(ACTDEV));
  2274.             FILERR;
  2275.             end;
  2276.  
  2277.         \NOT A VALID FILE NAME SO IT MUST BE A COMMAND
  2278.         ACTDEV:= RDEV;
  2279.         HASH:= LOCNAM(0) + SWAP(LOCNAM(1));
  2280.         case HASH of
  2281.            17735\GE\: CMDGET;
  2282.            21587\ST\: CMDSTART(true);
  2283.            22355\SW\: CMDSTART(false);
  2284.         \  21335\\WS\\: CMDWS;
  2285.            17742\NE\: CMDNEW(SYSPAG(SYSUNT));
  2286.            22867\SY\: CMDSYS;
  2287.            18771\SI\: CMDSIZE;
  2288.            16708\DA\: CMDDATE;
  2289.            18756\DI\: CMDDIR;
  2290.            17474\BD\: CMDBD;
  2291.            18772\TI\: CMDTITLE;
  2292.            17754\ZE\: CMDZERO;
  2293.            17988\DF\: CMDDF;
  2294.            20292\DO\: CMDDO(true);
  2295.            20302\NO\: CMDDO(false);
  2296.            16717\MA\: CMDMAKE;
  2297.            $5153\SQ\: CMDSQ;
  2298.            17732\DE\: CMDDELETE;
  2299.            16723\SA\: CMDSAVE;
  2300.            20559\OP\: CMDOPEN("@@@","@@@");
  2301.            19523\CL\: CMDCLOSE;
  2302.            18764\LI\: CMDLIST;
  2303.            17746\RE\: CMDRENAME;
  2304.            20300\LO\: CMDUNLOCK(false);
  2305.            20053\UN\: CMDUNLOCK(true);
  2306.            21843\SU\: CMDSUB
  2307.         other [CHOUT(0,BEL); TXT("I BEG YOUR PARDON?"); DOREBEGIN];
  2308.         end;
  2309.     end;
  2310. end;    \MAIN
  2311. LOCK(true);
  2312.            21843\SU\: CMDSUB
  2313.         other [CHOUT(0,BEL); TXT("I BEG YOUR PARDON?"); DOREBEGIN];
  2314.         end;
  2315.     end;
  2316. end